diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2023-05-01 13:22:24 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2023-05-01 13:22:24 (GMT) |
| commit | 530e4b3bb9e1b9acd0231c4da1a29d73180a20d5 (patch) | |
| tree | d32275c10833e1cca203e0c05f52340d30682262 /tests | |
| parent | 528b7b71686a0bb1993b1cce1166b5b70d511d31 (diff) | |
| parent | 6c4b78cfa8c06ea5963591778902da74850d1985 (diff) | |
| download | tcl-530e4b3bb9e1b9acd0231c4da1a29d73180a20d5.zip tcl-530e4b3bb9e1b9acd0231c4da1a29d73180a20d5.tar.gz tcl-530e4b3bb9e1b9acd0231c4da1a29d73180a20d5.tar.bz2 | |
Merge 8.7
Diffstat (limited to 'tests')
83 files changed, 8900 insertions, 1425 deletions
diff --git a/tests/appendComp.test b/tests/appendComp.test index 66f2a5c..121b704 100644 --- a/tests/appendComp.test +++ b/tests/appendComp.test @@ -384,7 +384,7 @@ test appendComp-8.1 {defer error to runtime} -setup { # patch (no read traces run for lappend, append). The compiled tests are # failing for lappend (9.0/1) before the patch, showing how it invokes read # traces in the compiled path. The append tests are good (9.2/3). After the -# patch the failues are gone. +# patch the failures are gone. test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup { unset -nocomplain myvar diff --git a/tests/assemble.test b/tests/assemble.test index 55124d0..b656894 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -781,7 +781,7 @@ test assemble-7.43 {uplus} { } } -returnCodes error - -result {can't use non-numeric floating-point value as operand of "+"} + -result {can't use non-numeric floating-point value "NaN" as operand of "+"} } test assemble-7.43.1 {tryCvtToNumeric} { -body { diff --git a/tests/basic.test b/tests/basic.test index f4c57fe..c90d80e 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -348,7 +348,7 @@ test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespac test basic-20.3 {Tcl_GetCommandInfo, #-quoting} testcmdtoken { catch {rename \# ""} set x [testcmdtoken create \#] - testcmdtoken name $x + return [testcmdtoken name $x] } {{#} ::#} test basic-21.1 {Tcl_GetCommandName} {emptyTest} { diff --git a/tests/binary.test b/tests/binary.test index a43fb49..c51d0e9 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -512,10 +512,10 @@ test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian { } \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian { binary format f -3.402825e+38 -} \xFF\x7F\xFF\xFF +} \xFF\x80\x00\x00 test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian { binary format f -3.402825e+38 -} \xFF\xFF\x7F\xFF +} \x00\x00\x80\xFF test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian { binary format f -3.402825e-100 } \x80\x00\x00\x00 @@ -537,6 +537,18 @@ test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian { set a {1.6 3.4} binary format f1 $a } \xCD\xCC\xCC\x3F +test binary-13.20 {Tcl_BinaryObjCmd: format float Inf} bigEndian { + binary format f Inf +} \x7F\x80\x00\x00 +test binary-13.21 {Tcl_BinaryObjCmd: format float Inf} littleEndian { + binary format f Inf +} \x00\x00\x80\x7F +test binary-13.22 {Tcl_BinaryObjCmd: format float -Inf} bigEndian { + binary format f -Inf +} \xFF\x80\x00\x00 +test binary-13.23 {Tcl_BinaryObjCmd: format float -Inf} littleEndian { + binary format f -Inf +} \x00\x00\x80\xFF test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body { binary format d @@ -767,7 +779,7 @@ test binary-21.13 {Tcl_BinaryObjCmd: scan} -setup { } -body { list [binary scan "abc def \x00 " C* arg1] $arg1 } -result {1 {abc def }} -test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup { +test binary-21.14 {Tcl_BinaryObjCmd: scan} -setup { unset -nocomplain arg1 } -body { list [binary scan "abc def \x00ghi" C* arg1] $arg1 @@ -1975,10 +1987,10 @@ test binary-53.11 {Tcl_BinaryObjCmd: format} {} { } \xCD\xCC\xCC\x3F\x9A\x99\x59\x40 test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} { binary format R -3.402825e+38 -} \xFF\x7F\xFF\xFF +} \xFF\x80\x00\x00 test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} { binary format r -3.402825e+38 -} \xFF\xFF\x7F\xFF +} \x00\x00\x80\xFF test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} { binary format R -3.402825e-100 } \x80\x00\x00\x00 @@ -2000,6 +2012,39 @@ test binary-53.19 {Tcl_BinaryObjCmd: format} {} { set a {1.6 3.4} binary format r1 $a } \xCD\xCC\xCC\x3F +test binary-53.20 {Tcl_BinaryObjCmd: float Inf} {} { + binary format R Inf +} \x7f\x80\x00\x00 +test binary-53.21 {Tcl_BinaryObjCmd: float Inf} {} { + binary format r Inf +} \x00\x00\x80\x7f +test binary-53.22 {Binary float Inf round trip} -body { + binary scan [binary format R Inf] R inf + binary scan [binary format R -Inf] R inf_ + list $inf $inf_ +} -result {Inf -Inf} +test binary-53.23 {Binary float round to FLT_MAX} -body { + binary scan [binary format H* 7f7fffff] R fltmax + binary scan [binary format H* 47effffff0000000] Q round_to_fltmax + binary scan [binary format R $round_to_fltmax] R fltmax1 + expr {$fltmax eq $fltmax1} +} -result 1 +test binary-53.24 {Binary float round to -FLT_MAX} -body { + binary scan [binary format H* ff7fffff] R fltmax + binary scan [binary format H* c7effffff0000000] Q round_to_fltmax + binary scan [binary format R $round_to_fltmax] R fltmax1 + expr {$fltmax eq $fltmax1} +} -result 1 +test binary-53.25 {Binary float round to Inf} -body { + binary scan [binary format H* 47effffff0000001] Q round_to_inf + binary scan [binary format R $round_to_inf] R inf1 + expr {$inf1 eq Inf} +} -result 1 +test binary-53.26 {Binary float round to -Inf} -body { + binary scan [binary format H* c7effffff0000001] Q round_to_inf + binary scan [binary format R $round_to_inf] R inf1 + expr {$inf1 eq -Inf} +} -result 1 # scan t (s) test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body { @@ -2396,11 +2441,27 @@ test binary-62.4 {infinity} ieeeFloatingPoint { format 0x%016lx $w } 0xfff0000000000000 test binary-62.5 {infinity} ieeeFloatingPoint { - binary scan [binary format w 0x7ff0000000000000] q d + binary scan [binary format w 0x7FF0000000000000] q d set d } Inf test binary-62.6 {infinity} ieeeFloatingPoint { - binary scan [binary format w 0xfff0000000000000] q d + binary scan [binary format w 0xFFF0000000000000] q d + set d +} -Inf +test binary-62.7 {infinity} ieeeFloatingPoint { + binary scan [binary format r Inf] iu i + format 0x%08x $i +} 0x7f800000 +test binary-62.8 {infinity} ieeeFloatingPoint { + binary scan [binary format r -Inf] iu i + format 0x%08x $i +} 0xff800000 +test binary-62.9 {infinity} ieeeFloatingPoint { + binary scan [binary format i 0x7F800000] r d + set d +} Inf +test binary-62.10 {infinity} ieeeFloatingPoint { + binary scan [binary format i 0xFF800000] r d set d } -Inf @@ -2408,19 +2469,19 @@ test binary-62.6 {infinity} ieeeFloatingPoint { test binary-63.1 {NaN} ieeeFloatingPoint { binary scan [binary format q NaN] w w - format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] + format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}] } 0x7ff0000000000000 test binary-63.2 {NaN} ieeeFloatingPoint { binary scan [binary format q -NaN] w w - format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] + format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}] } 0xfff0000000000000 test binary-63.3 {NaN} ieeeFloatingPoint { binary scan [binary format q NaN(3123456789aBc)] w w - format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] + format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}] } 0x7ff3123456789abc test binary-63.4 {NaN} ieeeFloatingPoint { binary scan [binary format q {NaN( 3123456789aBc)}] w w - format 0x%016lx [expr {$w & 0xfff3ffffffffffff}] + format 0x%016lx [expr {$w & 0xFFF3FFFFFFFFFFFF}] } 0x7ff3123456789abc # Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540] diff --git a/tests/chanio.test b/tests/chanio.test index 8d922a2..179d7a7 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -39,7 +39,7 @@ namespace eval ::tcl::test::io { package require -exact tcl::test [info patchlevel] set ::tcltestlib [info loaded {} Tcltest] } - package require tcltests + source [file join [file dirname [info script]] tcltests.tcl] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] @@ -50,6 +50,8 @@ namespace eval ::tcl::test::io { testConstraint notWinCI [expr { $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}] testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] + # File permissions broken on wsl without some "exotic" wsl configuration + testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] testConstraint specialfiles [expr {[file exists /dev/zero] || [file exists NUL]}] # You need a *very* special environment to do some tests. In particular, @@ -80,7 +82,7 @@ namespace eval ::tcl::test::io { if {$argv != ""} { set f [open [lindex $argv 0]] } - chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A + chan configure $f -encoding binary -translation lf -blocking 0 -eofchar "\x1A \x1A" chan configure stdout -encoding binary -translation lf -buffering none chan event $f readable "foo $f" proc foo {f} { @@ -116,10 +118,10 @@ set path(test1) [makeFile {} test1] test chan-io-1.6 {Tcl_WriteChars: WriteBytes} { set f [open $path(test1) w] chan configure $f -encoding binary - chan puts -nonewline $f "a乍\x00" + chan puts -nonewline $f "a\x4D\x00" chan close $f contents $path(test1) -} "aM\x00" +} aM\x00 test chan-io-1.7 {Tcl_WriteChars: WriteChars} { set f [open $path(test1) w] chan configure $f -encoding shiftjis @@ -252,7 +254,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -bod test chan-io-3.4 {WriteChars: loop over stage buffer} -body { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 16 + chan configure $f -encoding jis0208 -buffersize 16 -profile tcl8 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f @@ -265,7 +267,7 @@ test chan-io-3.5 {WriteChars: saved != 0} -body { # be moved to beginning of next channel buffer to preserve requested # buffersize. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 17 + chan configure $f -encoding jis0208 -buffersize 17 -profile tcl8 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f @@ -284,7 +286,7 @@ test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} -body { # last byte of Ａ plus the all of Ｂ) appended. set f [open $path(test1) w] chan configure $f -encoding shiftjis -buffersize 16 - chan puts -nonewline $f "12345678901234ＡＢ" + chan puts -nonewline $f 12345678901234ＡＢ set x [list [contents $path(test1)]] chan close $f lappend x [contents $path(test1)] @@ -298,7 +300,7 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body { # on flush. The truncated bytes are moved to the beginning of the next # channel buffer. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 17 + chan configure $f -encoding jis0208 -buffersize 17 -profile tcl8 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f @@ -432,7 +434,7 @@ test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body { test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body { set f [open $path(test1) w] chan configure $f -translation binary - chan puts $f "\x81\u1234\x00" + chan puts $f "\x81\x34\x00" chan close $f set f [open $path(test1)] chan configure $f -translation binary @@ -481,7 +483,7 @@ test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body { chan puts $f "abcdef\x1Aghijk\nwombat" chan close $f set f [open $path(test1)] - chan configure $f -eofchar \x1A + chan configure $f -eofchar "\x1A \x1A" list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f @@ -491,7 +493,7 @@ test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body { chan puts $f "abcdefghijk\nwom\x1Abat" chan close $f set f [open $path(test1)] - chan configure $f -eofchar \x1A + chan configure $f -eofchar "\x1A \x1A" list [chan gets $f line] $line [chan gets $f line] $line } -cleanup { chan close $f @@ -999,7 +1001,7 @@ test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -b chan puts -nonewline $f "123456\x1Ak9012345\r" chan close $f set f [open $path(test1)] - chan configure $f -eofchar \x1A + chan configure $f -eofchar "\x1A \x1A" list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f] } -cleanup { chan close $f @@ -1216,7 +1218,7 @@ test chan-io-8.7 {PeekAhead: cleanup} -setup { chan puts -nonewline $f "abcdefghijklmno\r" # here lappend x [chan gets $f line] $line [testchannel queuedcr $f] - chan puts -nonewline $f "\x1A" + chan puts -nonewline $f \x1A lappend x [chan gets $f line] $line } -cleanup { chan close $f @@ -1372,22 +1374,22 @@ test chan-io-12.4 {ReadChars: split-up char} -setup { chan configure $f -encoding shiftjis vwait [namespace which -variable x] chan configure $f -encoding binary -blocking 1 - chan puts -nonewline $f "\x7B" + chan puts -nonewline $f \x7B after 500 ;# Give the cat process time to catch up chan configure $f -encoding shiftjis -blocking 0 vwait [namespace which -variable x] return $x } -cleanup { chan close $f -} -result [list "123456789012345" 1 "本" 0] +} -result [list "123456789012345" 1 本 0] test chan-io-12.5 {ReadChars: chan events on partial characters} -setup { variable x {} } -constraints {stdio fileevent} -body { set path(test1) [makeFile { chan configure stdout -encoding binary -buffering none - chan gets stdin; chan puts -nonewline "\xE7" - chan gets stdin; chan puts -nonewline "\x89" - chan gets stdin; chan puts -nonewline "\xA6" + chan gets stdin; chan puts -nonewline \xE7 + chan gets stdin; chan puts -nonewline \x89 + chan gets stdin; chan puts -nonewline \xA6 } test1] set f [openpipe r+ $path(test1)] chan event $f readable [namespace code { @@ -3105,7 +3107,7 @@ test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup { chan puts -nonewline $f hello\nthere\nand\rhere\n\x1A chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" chan read $f } -cleanup { chan close $f @@ -3118,11 +3120,11 @@ test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup { file delete $path(test1) } -constraints {win} -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" chan read $f } -cleanup { chan close $f @@ -3140,7 +3142,7 @@ test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $s chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [chan gets $f] lappend l [chan gets $f] @@ -3161,7 +3163,7 @@ test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup { chan puts $f $s chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [chan gets $f] lappend l [chan gets $f] @@ -3239,7 +3241,7 @@ test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup { chan puts $f [format abc\ndef\n%cqrs\ntuv 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3253,7 +3255,7 @@ test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3267,7 +3269,7 @@ test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3281,7 +3283,7 @@ test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1A + chan configure $f -translation cr -eofchar "\x1A \x1A" list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3295,7 +3297,7 @@ test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3309,7 +3311,7 @@ test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup { chan puts $f $c chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1A + chan configure $f -translation crlf -eofchar "\x1A \x1A" list [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -3570,7 +3572,7 @@ test chan-io-31.13 {binary mode is synonym of lf mode} -setup { } -result lf # # Test chan-io-9.14 has been removed because "auto" output translation mode is -# not supoprted. +# not supported. # test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} -setup { file delete $path(test1) @@ -3660,7 +3662,7 @@ test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup { chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] @@ -3676,11 +3678,11 @@ test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup { set l "" } -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" chan puts $f hello\nthere\nand\rhere chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan gets $f] @@ -3700,7 +3702,7 @@ test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3718,7 +3720,7 @@ test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3802,7 +3804,7 @@ test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3820,7 +3822,7 @@ test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3838,7 +3840,7 @@ test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3856,7 +3858,7 @@ test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1A + chan configure $f -translation cr -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3874,7 +3876,7 @@ test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -3892,7 +3894,7 @@ test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup { chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1A + chan configure $f -translation crlf -eofchar "\x1A \x1A" lappend l [chan gets $f] lappend l [chan gets $f] lappend l [chan eof $f] @@ -4648,12 +4650,12 @@ test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4662,12 +4664,12 @@ test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4676,12 +4678,12 @@ test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation cr -eofchar \x1A + chan configure $f -translation cr -eofchar "\x1A \x1A" chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4690,12 +4692,12 @@ test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation cr -eofchar \x1A + chan configure $f -translation cr -eofchar "\x1A \x1A" chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1A + chan configure $f -translation cr -eofchar "\x1A \x1A" list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4704,12 +4706,12 @@ test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation crlf -eofchar \x1A + chan configure $f -translation crlf -eofchar "\x1A \x1A" chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4718,12 +4720,12 @@ test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup { file delete $path(test1) } -body { set f [open $path(test1) w] - chan configure $f -translation crlf -eofchar \x1A + chan configure $f -translation crlf -eofchar "\x1A \x1A" chan puts $f abc\ndef chan close $f set s [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1A + chan configure $f -translation crlf -eofchar "\x1A \x1A" list $s [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4737,7 +4739,7 @@ test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4751,7 +4753,7 @@ test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4765,7 +4767,7 @@ test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4779,7 +4781,7 @@ test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1A + chan configure $f -translation cr -eofchar "\x1A \x1A" list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4793,7 +4795,7 @@ test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4807,7 +4809,7 @@ test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup { chan close $f set c [file size $path(test1)] set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1A + chan configure $f -translation crlf -eofchar "\x1A \x1A" list $c [string length [chan read $f]] [chan eof $f] } -cleanup { chan close $f @@ -4980,7 +4982,7 @@ test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} -setup { test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed set chan [open [info script] r] - chan configure $chan -buffersize 10 + chan configure $chan -buffersize 10 -encoding utf-8 set var [chan read $chan 2] chan configure $chan -buffersize 32 append var [chan read $chan] @@ -5211,7 +5213,7 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_ } -constraints {stdio fileevent} -body { set f [openpipe r+ $path(cat)] chan configure $f -encoding binary - chan puts -nonewline $f "\xE7" + chan puts -nonewline $f \xE7 chan flush $f chan configure $f -encoding utf-8 -blocking 0 chan event $f readable [namespace code { lappend x [chan read $f] }] @@ -5290,7 +5292,7 @@ test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup { lappend l [chan configure $f1 -eofchar] chan configure $f1 -eofchar {ON GO} lappend l [chan configure $f1 -eofchar] - chan configure $f1 -eofchar D + chan configure $f1 -eofchar {D D} lappend l [chan configure $f1 -eofchar] } -cleanup { chan close $f1 @@ -5302,14 +5304,16 @@ test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup { set f1 [open $path(test1) w+] chan configure $f1 -eofchar {ON GO} lappend l [chan configure $f1 -eofchar] - chan configure $f1 -eofchar D + chan configure $f1 -eofchar {D D} lappend l [chan configure $f1 -eofchar] lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg] } -cleanup { chan close $f1 } -result {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} -test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\ - writeable, it should still have valid -eofchar and -translation options} -setup { +test chan-io-39.23 { + Tcl_GetChannelOption, server socket is not readable or writable, but should + still have valid -eofchar and -translation options. +} -setup { set l [list] } -body { set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] @@ -5348,7 +5352,7 @@ test chan-io-40.1 {POSIX open access modes: RDWR} -setup { } -result {zzy abzzy} test chan-io-40.2 {POSIX open access modes: CREAT} -setup { file delete $path(test3) -} -constraints {unix} -body { +} -constraints {unix notWsl} -body { set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats set x [format 0o%03o [expr {$stats(mode) & 0o777}]] @@ -5361,7 +5365,7 @@ test chan-io-40.2 {POSIX open access modes: CREAT} -setup { } -result {0o600 {line 1}} test chan-io-40.3 {POSIX open access modes: CREAT} -setup { file delete $path(test3) -} -constraints {unix umask} -body { +} -constraints {unix umask notWsl} -body { # This test only works if your umask is 2, like ouster's. chan close [open $path(test3) {WRONLY CREAT}] file stat $path(test3) stats @@ -6047,7 +6051,7 @@ test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6071,7 +6075,7 @@ test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6095,7 +6099,7 @@ test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6119,7 +6123,7 @@ test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6143,7 +6147,7 @@ test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mo chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6167,7 +6171,7 @@ test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1A + chan configure $f -translation auto -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6191,7 +6195,7 @@ test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} - chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6215,7 +6219,7 @@ test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1A + chan configure $f -translation lf -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6239,7 +6243,7 @@ test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} - chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1A + chan configure $f -translation cr -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6263,7 +6267,7 @@ test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1A + chan configure $f -translation cr -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6287,7 +6291,7 @@ test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mod chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1A + chan configure $f -translation crlf -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6311,7 +6315,7 @@ test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} - chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1A + chan configure $f -translation crlf -eofchar "\x1A \x1A" chan event $f readable [namespace code { if {[chan eof $f]} { set x done @@ -6705,8 +6709,8 @@ test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup { } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] - chan configure $f1 -translation lf -blocking 0 - chan configure $f2 -translation cr -blocking 0 + chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 + chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0 set s0 [chan copy $f1 $f2] set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 @@ -6736,8 +6740,8 @@ test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup { } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] - chan configure $f1 -translation lf -blocking 0 - chan configure $f2 -translation lf -blocking 0 + chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 + chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified. set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 @@ -6752,8 +6756,8 @@ test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup { } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] - chan configure $f1 -translation lf -blocking 0 - chan configure $f2 -translation lf -blocking 0 + chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 + chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 @@ -6768,8 +6772,8 @@ test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup { } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] - chan configure $f1 -translation lf -blocking 0 - chan configure $f2 -translation lf -blocking 0 + chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 + chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 @@ -6784,8 +6788,8 @@ test chan-io-52.6 {TclCopyChannel} -setup { } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] - chan configure $f1 -translation lf -blocking 0 - chan configure $f2 -translation lf -blocking 0 + chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 + chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]] set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 @@ -6802,8 +6806,8 @@ test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup { } -body { set f1 [open $thisScript] set f2 [open $path(test1) w] - chan configure $f1 -translation lf -blocking 0 - chan configure $f2 -translation lf -blocking 0 + chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 + chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] if {[file size $thisScript] == [file size $path(test1)]} { @@ -6848,7 +6852,7 @@ set path(utf8-rp.txt) [makeFile {} utf8-rp.txt] # Create kyrillic file, use lf translation to avoid os eol issues set out [open $path(kyrillic.txt) w] chan configure $out -encoding koi8-r -translation lf -chan puts $out "АА" +chan puts $out АА chan close $out test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} { # Copy kyrillic to UTF-8, using chan copy. @@ -6871,7 +6875,7 @@ test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} -test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} { +test chan-io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { # encoding to binary (=> implies that the internal utf-8 is written) set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] @@ -6886,7 +6890,7 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} { test chan-io-52.11 {TclCopyChannel & encodings} -setup { set f [open $path(utf8-fcopy.txt) w] fconfigure $f -encoding utf-8 -translation lf - puts $f "АА" + puts $f АА close $f } -constraints {fcopy} -body { # binary to encoding => the input has to be in utf-8 to make sense to the @@ -6920,8 +6924,8 @@ test chan-io-53.2 {CopyData} -setup { } -constraints {fcopy} -body { set f1 [open $thisScript] set f2 [open $path(test1) w] - chan configure $f1 -translation lf -blocking 0 - chan configure $f2 -translation cr -blocking 0 + chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0 + chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0 chan copy $f1 $f2 -command [namespace code {set s0}] set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] variable s0 @@ -7583,7 +7587,7 @@ test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} { # cut of the remainder of the error stack, especially the filename set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]] list $x $result -} {1 {gets {} catch {error writing "stdout": illegal byte sequence}}} +} {1 {gets {} catch {error writing "stdout": invalid or incomplete multibyte or wide character}}} test chan-io-61.1 {Reset eof state after changing the eof char} -setup { set datafile [makeFile {} eofchar] @@ -7611,7 +7615,7 @@ test chan-io-61.1 {Reset eof state after changing the eof char} -setup { removeFile eofchar } -result {77 = 23431} -# Test the cutting and splicing of channels, this is incidentially the +# Test the cutting and splicing of channels, this is incidentally the # attach/detach facility of package Thread, but __without any safeguards__. It # can also be used to emulate transfer of channels between threads, and is # used for that here. diff --git a/tests/clock.test b/tests/clock.test index 2a53259..0b385c9 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36043,7 +36043,7 @@ test clock-42.1 {regression test - %z in :localtime when west of Greenwich } \ } \ -result {-0500} -# 43.1 was a bad test - mktime returning -1 is an error according to posix. +# 43.1 was a bad test - mktime returning -1 is an error according to Posix. test clock-44.1 {regression test - time zone name containing hyphen } \ -setup { diff --git a/tests/cmdAH.test b/tests/cmdAH.test index a9e199e..f024f36 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -21,6 +21,7 @@ catch [list package require -exact tcl::test [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] +testConstraint testbytestring [llength [info commands testbytestring]] testConstraint time64bit [expr { $::tcl_platform(pointerSize) >= 8 || [llength [info command testsize]] && [testsize st_mtime] >= 8 @@ -31,6 +32,8 @@ testConstraint linkDirectory [expr { && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") }] testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] +# File permissions broken on wsl without some "exotic" wsl configuration +testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] global env set cmdAHwd [pwd] @@ -170,186 +173,514 @@ test cmdAH-3.2 {Tcl_ContinueObjCmd, success} { list [catch {continue} msg] $msg } {4 {}} -test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body { +### +# encoding command + +set "numargErrors(encoding system)" {^wrong # args: should be "(encoding |::tcl::encoding::)system \?encoding\?"$} +set "numargErrors(encoding convertfrom)" {wrong # args: should be "(encoding |::tcl::encoding::)convertfrom \?-profile profile\? \?-failindex var\? encoding data" or "(encoding |::tcl::encoding::)convertfrom data"} +set "numargErrors(encoding convertto)" {wrong # args: should be "(encoding |::tcl::encoding::)convertto \?-profile profile\? \?-failindex var\? encoding data" or "(encoding |::tcl::encoding::)convertto data"} +set "numargErrors(encoding names)" {wrong # args: should be "encoding names"} +set "numargErrors(encoding profiles)" {wrong # args: should be "encoding profiles"} + +source [file join [file dirname [info script]] encodingVectors.tcl] + + +# Maps utf-{16,32}{le,be} to utf-16, utf-32 and +# others to "". Used to test utf-16, utf-32 based +# on system endianness +proc endianUtf {enc} { + if {$::tcl_platform(byteOrder) eq "littleEndian"} { + set endian le + } else { + set endian be + } + if {$enc eq "utf-16$endian" || $enc eq "utf-32$endian"} { + return [string range $enc 0 5] + } + return "" +} + +# Map arbitrary strings to printable form in ASCII. +proc printable {s} { + set print "" + foreach c [split $s ""] { + set i [scan $c %c] + if {[string is print $c] && ($i <= 127)} { + append print $c + } elseif {$i <= 0xff} { + append print \\x[format %02X $i] + } elseif {$i <= 0xffff} { + append print \\u[format %04X $i] + } else { + append print \\U[format %08X $i] + } + } + return $print +} + +# +# Check errors for invalid number of arguments +proc badnumargs {id cmd cmdargs} { + variable numargErrors + test $id.a "Syntax error: $cmd $cmdargs" \ + -body [list {*}$cmd {*}$cmdargs] \ + -result $numargErrors($cmd) \ + -match regexp \ + -returnCodes error + test $id.b "Syntax error: $cmd (byte compiled)" \ + -setup [list proc compiled_proc {} [list {*}$cmd {*}$cmdargs]] \ + -body {compiled_proc} \ + -cleanup {rename compiled_proc {}} \ + -result $numargErrors($cmd) \ + -match regexp \ + -returnCodes error +} + +# Wraps tests resulting in unknown encoding errors +proc unknownencodingtest {id cmd} { + set result "unknown encoding \"[lindex $cmd end-1]\"" + test $id.a "Unknown encoding error: $cmd" \ + -body [list encoding {*}$cmd] \ + -result $result \ + -returnCodes error + test $id.b "Syntax error: $cmd (byte compiled)" \ + -setup [list proc encoding_test {} [list encoding {*}$cmd]] \ + -body {encoding_test} \ + -cleanup {rename encoding_test {}} \ + -result $result \ + -returnCodes error +} + +# Wraps tests for conversion, successful or not. +# Really more general than just for encoding conversion. +proc testconvert {id body result args} { + test $id.a $body \ + -body $body \ + -result $result \ + {*}$args + dict append args -setup \n[list proc compiled_script {} $body] + dict append args -cleanup "\nrename compiled_script {}" + test $id.b "$body (byte compiled)" \ + -body {compiled_script} \ + -result $result \ + {*}$args +} + +# Wrapper to verify encoding convert{to,from} ?-profile? +# Generates tests for compiled and uncompiled implementation. +# Also generates utf-{16,32} tests if passed encoding is utf-{16,32}{le,be} +# The enc and profile are appended to id to generate the test id +proc testprofile {id converter enc profile data result args} { + testconvert $id.$enc.$profile [list encoding $converter -profile $profile $enc $data] $result {*}$args + if {[set enc2 [endianUtf $enc]] ne ""} { + # If utf{16,32}-{le,be}, also do utf{16,32} + testconvert $id.$enc2.$profile [list encoding $converter -profile $profile $enc2 $data] $result {*}$args + } + + # If this is the default profile, generate a test without specifying profile + if {$profile eq $::encDefaultProfile} { + testconvert $id.$enc.default [list encoding $converter $enc $data] $result {*}$args + if {[set enc2 [endianUtf $enc]] ne ""} { + # If utf{16,32}-{le,be}, also do utf{16,32} + testconvert $id.$enc2.default [list encoding $converter $enc2 $data] $result {*}$args + } + } +} + + +# Wrapper to verify encoding convert{to,from} -failindex ?-profile? +# Generates tests for compiled and uncompiled implementation. +# Also generates utf-{16,32} tests if passed encoding is utf-{16,32}{le,be} +# The enc and profile are appended to id to generate the test id +proc testfailindex {id converter enc data result failidx {profile default}} { + testconvert $id.$enc.$profile "list \[encoding $converter -profile $profile -failindex idx $enc [list $data]\] \[set idx\]" [list $result $failidx] + if {[set enc2 [endianUtf $enc]] ne ""} { + # If utf{16,32}-{le,be}, also do utf{16,32} + testconvert $id.$enc2.$profile "list \[encoding $converter -profile $profile -failindex idx $enc2 [list $data]\] \[set idx]" [list $result $failidx] + } + + # If this is the default profile, generate a test without specifying profile + if {$profile eq $::encDefaultProfile} { + testconvert $id.$enc.default "list \[encoding $converter -failindex idx $enc [list $data]\] \[set idx]" [list $result $failidx] + if {[set enc2 [endianUtf $enc]] ne ""} { + # If utf{16,32}-{le,be}, also do utf{16,32} + testconvert $id.$enc2.default "list \[encoding $converter -failindex idx $enc2 [list $data]\] \[set idx]" [list $result $failidx] + } + } +} + +test cmdAH-4.1.1 {encoding} -returnCodes error -body { encoding } -result {wrong # args: should be "encoding subcommand ?arg ...?"} -test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body { +test cmdAH-4.1.2 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding foo -} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system} -test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body { - encoding convertto -} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body { - encoding convertto foo bar -} -result {unknown encoding "foo"} -test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup { +} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, profiles, or system} + +# +# encoding system 4.2.* +badnumargs cmdAH-4.2.1 {encoding system} {ascii ascii} +test cmdAH-4.2.2 {Tcl_EncodingObjCmd} -setup { set system [encoding system] } -body { - encoding system jis0208 - encoding convertto 乎 + encoding system iso8859-1 + encoding system } -cleanup { encoding system $system -} -result 8C -test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup { +} -result iso8859-1 + +# +# encoding convertfrom 4.3.* + +# Odd number of args is always invalid since last two args +# are ENCODING DATA and all options take a value +badnumargs cmdAH-4.3.1 {encoding convertfrom} {} +badnumargs cmdAH-4.3.2 {encoding convertfrom} {-failindex VAR ABC} +badnumargs cmdAH-4.3.3 {encoding convertfrom} {-profile VAR ABC} +badnumargs cmdAH-4.3.4 {encoding convertfrom} {-failindex VAR -profile strict ABC} +badnumargs cmdAH-4.3.5 {encoding convertfrom} {-profile strict -failindex VAR ABC} + +# Test that last two args always treated as ENCODING DATA +unknownencodingtest cmdAH-4.3.6 {convertfrom -failindex ABC} +unknownencodingtest cmdAH-4.3.7 {convertfrom -profile ABC} +unknownencodingtest cmdAH-4.3.8 {convertfrom nosuchencoding ABC} +unknownencodingtest cmdAH-4.3.9 {convertfrom -failindex VAR -profile ABC} +unknownencodingtest cmdAH-4.3.10 {convertfrom -profile strict -failindex ABC} +testconvert cmdAH-4.3.11 { + encoding convertfrom jis0208 \x38\x43 +} \u4e4e -setup { set system [encoding system] -} -body { encoding system iso8859-1 - encoding convertto jis0208 乎 } -cleanup { encoding system $system -} -result 8C -test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body { - encoding convertfrom -} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body { - encoding convertfrom foo bar -} -result {unknown encoding "foo"} -test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup { +} + +# Verify single arg defaults to system encoding +testconvert cmdAH-4.3.12 { + encoding convertfrom \x38\x43 +} \u4e4e -setup { set system [encoding system] -} -body { encoding system jis0208 - encoding convertfrom 8C } -cleanup { encoding system $system -} -result 乎 -test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup { +} + +# convertfrom ?-profile? : valid byte sequences +foreach {enc str hex ctrl comment} $encValidStrings { + if {"knownBug" in $ctrl} continue + set bytes [binary decode hex $hex] + set prefix A + set suffix B + set prefix_bytes [encoding convertto $enc A] + set suffix_bytes [encoding convertto $enc B] + foreach profile $encProfiles { + testprofile cmdAH-4.3.13.$hex.solo convertfrom $enc $profile $bytes $str + testprofile cmdAH-4.3.13.$hex.lead convertfrom $enc $profile $bytes$suffix_bytes $str$suffix + testprofile cmdAH-4.3.13.$hex.tail convertfrom $enc $profile $prefix_bytes$bytes $prefix$str + testprofile cmdAH-4.3.13.$hex.middle convertfrom $enc $profile $prefix_bytes$bytes$suffix_bytes $prefix$str$suffix + } +} + +# convertfrom ?-profile? : invalid byte sequences +foreach {enc hex profile str failidx ctrl comment} $encInvalidBytes { + if {"knownBug" in $ctrl} continue + set bytes [binary format H* $hex] + set prefix A + set suffix B + set prefix_bytes [encoding convertto $enc $prefix] + set suffix_bytes [encoding convertto $enc $suffix] + set prefixLen [string length $prefix_bytes] + set result [list $str] + # TODO - if the bad byte is unprintable, tcltest errors out when printing a mismatch + # so glob it out in error message pattern for now. + set errorWithoutPrefix [list "unexpected byte sequence starting at index $failidx: *" -returnCodes error -match glob] + set errorWithPrefix [list "unexpected byte sequence starting at index [expr {$failidx+$prefixLen}]: *" -returnCodes error -match glob] + if {$ctrl eq {} || "solo" in $ctrl} { + if {$failidx == -1} { + set result [list $str] + } else { + set result $errorWithoutPrefix + } + testprofile cmdAH-4.3.13.$hex.solo convertfrom $enc $profile $bytes {*}$result + } + if {$ctrl eq {} || "lead" in $ctrl} { + if {$failidx == -1} { + set result [list $str$suffix] + } else { + set result $errorWithoutPrefix + } + testprofile cmdAH-4.3.13.$hex.lead convertfrom $enc $profile $bytes$suffix_bytes {*}$result + } + if {$ctrl eq {} || "tail" in $ctrl} { + if {$failidx == -1} { + set result [list $prefix$str] + } else { + set result $errorWithPrefix + } + testprofile cmdAH-4.3.13.$hex.tail convertfrom $enc $profile $prefix_bytes$bytes {*}$result + } + if {$ctrl eq {} || "middle" in $ctrl} { + if {$failidx == -1} { + set result [list $prefix$str$suffix] + } else { + set result $errorWithPrefix + } + testprofile cmdAH-4.3.13.$hex.middle convertfrom $enc $profile $prefix_bytes$bytes$suffix_bytes {*}$result + } +} + +# convertfrom -failindex ?-profile? - valid data +foreach {enc str hex ctrl comment} $encValidStrings { + if {"knownBug" in $ctrl} continue + set bytes [binary decode hex $hex] + set prefix A + set suffix B + set prefix_bytes [encoding convertto $enc $prefix] + set suffix_bytes [encoding convertto $enc $suffix] + foreach profile $encProfiles { + testfailindex cmdAH-4.3.14.$hex.solo convertfrom $enc $bytes $str -1 $profile + testfailindex cmdAH-4.3.14.$hex.lead convertfrom $enc $bytes$suffix_bytes $str$suffix -1 $profile + testfailindex cmdAH-4.3.14.$hex.tail convertfrom $enc $prefix_bytes$bytes $prefix$str -1 $profile + testfailindex cmdAH-4.3.14.$hex.middle convertfrom $enc $prefix_bytes$bytes$suffix_bytes $prefix$str$suffix -1 $profile + } +} + +# convertfrom -failindex ?-profile? - invalid data +foreach {enc hex profile str failidx ctrl comment} $encInvalidBytes { + if {"knownBug" in $ctrl} continue + # There are multiple test cases based on location of invalid bytes + set bytes [binary decode hex $hex] + set prefix A + set suffix B + set prefix_bytes [encoding convertto $enc $prefix] + set suffix_bytes [encoding convertto $enc $suffix] + set prefixLen [string length $prefix_bytes] + if {$ctrl eq {} || "solo" in $ctrl} { + testfailindex cmdAH-4.3.14.$hex.solo convertfrom $enc $bytes $str $failidx $profile + } + if {$ctrl eq {} || "lead" in $ctrl} { + if {$failidx == -1} { + # If success expected + set result $str$suffix + } else { + # Failure expected + set result "" + } + testfailindex cmdAH-4.3.14.$hex.lead convertfrom $enc $bytes$suffix_bytes $result $failidx $profile + } + if {$ctrl eq {} || "tail" in $ctrl} { + set expected_failidx $failidx + if {$failidx == -1} { + # If success expected + set result $prefix$str + } else { + # Failure expected + set result $prefix + incr expected_failidx $prefixLen + } + testfailindex cmdAH-4.3.14.$hex.tail convertfrom $enc $prefix_bytes$bytes $result $expected_failidx $profile + } + if {$ctrl eq {} || "middle" in $ctrl} { + set expected_failidx $failidx + if {$failidx == -1} { + # If success expected + set result $prefix$str$suffix + } else { + # Failure expected + set result $prefix + incr expected_failidx $prefixLen + } + testfailindex cmdAH-4.3.14.$hex.middle convertfrom $enc $prefix_bytes$bytes$suffix_bytes $result $expected_failidx $profile + } +} + +# +# encoding convertto 4.4.* + +badnumargs cmdAH-4.4.1 {encoding convertto} {} +badnumargs cmdAH-4.4.2 {encoding convertto} {-failindex VAR ABC} +badnumargs cmdAH-4.4.3 {encoding convertto} {-profile VAR ABC} +badnumargs cmdAH-4.4.4 {encoding convertto} {-failindex VAR -profile strict ABC} +badnumargs cmdAH-4.4.5 {encoding convertto} {-profile strict -failindex VAR ABC} + +# Test that last two args always treated as ENCODING DATA +unknownencodingtest cmdAH-4.4.6 {convertto -failindex ABC} +unknownencodingtest cmdAH-4.4.7 {convertto -profile ABC} +unknownencodingtest cmdAH-4.4.8 {convertto nosuchencoding ABC} +unknownencodingtest cmdAH-4.4.9 {convertto -failindex VAR -profile ABC} +unknownencodingtest cmdAH-4.4.10 {convertto -profile strict -failindex ABC} +testconvert cmdAH-4.4.11 { + encoding convertto jis0208 \u4e4e +} \x38\x43 -setup { set system [encoding system] -} -body { encoding system iso8859-1 - encoding convertfrom jis0208 8C } -cleanup { encoding system $system -} -result 乎 -test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body { - encoding names foo -} -result {wrong # args: should be "encoding names"} -test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body { - encoding system foo bar -} -result {wrong # args: should be "encoding system ?encoding?"} -test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup { +} + +# Verify single arg defaults to system encoding +testconvert cmdAH-4.4.12 { + encoding convertto \u4e4e +} \x38\x43 -setup { set system [encoding system] -} -body { - encoding system iso8859-1 - encoding system + encoding system jis0208 } -cleanup { encoding system $system -} -result iso8859-1 +} + +# convertto ?-profile? : valid byte sequences -test cmdAH-4.14.1 {Syntax error, -nocomplain and -failindex, no encoding} -body { - encoding convertfrom -nocomplain -failindex 2 ABC -} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.14.2 {Syntax error, -nocomplain and -failindex, no encoding} -body { - encoding convertto -nocomplain -failindex 2 ABC -} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.15.1 {Syntax error, -failindex and -nocomplain, no encoding} -body { - encoding convertfrom -failindex 2 -nocomplain ABC -} -returnCodes 1 -result {unknown encoding "-nocomplain"} -test cmdAH-4.15.2 {Syntax error, -failindex and -nocomplain, no encoding} -body { - encoding convertto -failindex 2 -nocomplain ABC -} -returnCodes 1 -result {unknown encoding "-nocomplain"} -test cmdAH-4.16.1 {Syntax error, -nocomplain and -failindex, encoding} -body { - encoding convertfrom -nocomplain -failindex 2 utf-8 ABC -} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.16.2 {Syntax error, -nocomplain and -failindex, encoding} -body { - encoding convertto -nocomplain -failindex 2 utf-8 ABC -} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.17.1 {Syntax error, -failindex and -nocomplain, encoding} -body { - encoding convertfrom -failindex 2 -nocomplain utf-8 ABC -} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.17.2 {Syntax error, -failindex and -nocomplain, encoding} -body { - encoding convertto -failindex 2 -nocomplain utf-8 ABC -} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.18.1 {Syntax error, -failindex with no var, no encoding} -body { - encoding convertfrom -failindex ABC -} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.18.2 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup { - proc encoding_test {} { - encoding convertfrom -failindex ABC +foreach {enc str hex ctrl comment} $encValidStrings { + if {"knownBug" in $ctrl} continue + set bytes [binary decode hex $hex] + set printable [printable $str] + set prefix A + set suffix B + set prefix_bytes [encoding convertto $enc A] + set suffix_bytes [encoding convertto $enc B] + foreach profile $encProfiles { + testprofile cmdAH-4.4.13.$printable.solo convertto $enc $profile $str $bytes + testprofile cmdAH-4.4.13.$printable.lead convertto $enc $profile $str$suffix $bytes$suffix_bytes + testprofile cmdAH-4.4.13.$printable.tail convertto $enc $profile $prefix$str $prefix_bytes$bytes + testprofile cmdAH-4.4.13.$printable.middle convertto $enc $profile $prefix$str$suffix $prefix_bytes$bytes$suffix_bytes } -} -body { - # Compile and execute - encoding_test -} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} -cleanup { - rename encoding_test "" } -test cmdAH-4.18.3 {Syntax error, -failindex with no var, no encoding} -body { - encoding convertto -failindex ABC -} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -test cmdAH-4.18.4 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup { - proc encoding_test {} { - encoding convertto -failindex ABC + +# convertto ?-profile? : invalid byte sequences +foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings { + if {"knownBug" in $ctrl} continue + set bytes [binary decode hex $hex] + set printable [printable $str] + set prefix A + set suffix B + set prefix_bytes [encoding convertto $enc $prefix] + set suffix_bytes [encoding convertto $enc $suffix] + set prefixLen [string length $prefix_bytes] + set result [list $bytes] + # TODO - if the bad byte is unprintable, tcltest errors out when printing a mismatch + # so glob it out in error message pattern for now. + set errorWithoutPrefix [list "unexpected character at index $failidx: *" -returnCodes error -match glob] + set errorWithPrefix [list "unexpected character at index [expr {$failidx+$prefixLen}]: *" -returnCodes error -match glob] + if {$ctrl eq {} || "solo" in $ctrl} { + if {$failidx == -1} { + set result [list $bytes] + } else { + set result $errorWithoutPrefix + } + testprofile cmdAH-4.4.13.$printable.solo convertto $enc $profile $str {*}$result } -} -body { - # Compile and execute - encoding_test -} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"} -cleanup { - rename encoding_test "" -} -test cmdAH-4.19.1 {convertrom -failindex with correct data} -body { - encoding convertfrom -failindex test ABC - set test -} -returnCodes 0 -result -1 -test cmdAH-4.19.2 {convertrom -failindex with correct data (byt compiled)} -setup { - proc encoding_test {} { - encoding convertfrom -failindex test ABC - set test + if {$ctrl eq {} || "lead" in $ctrl} { + if {$failidx == -1} { + set result [list $bytes$suffix_bytes] + } else { + set result $errorWithoutPrefix + } + testprofile cmdAH-4.4.13.$printable.lead convertto $enc $profile $str$suffix {*}$result } -} -body { - # Compile and execute - encoding_test -} -returnCodes 0 -result -1 -cleanup { - rename encoding_test "" -} -test cmdAH-4.19.3 {convertrom -failindex with correct data} -body { - encoding convertto -failindex test ABC - set test -} -returnCodes 0 -result -1 -test cmdAH-4.19.4 {convertrom -failindex with correct data (byt compiled)} -setup { - proc encoding_test {} { - encoding convertto -failindex test ABC - set test + if {$ctrl eq {} || "tail" in $ctrl} { + if {$failidx == -1} { + set result [list $prefix_bytes$bytes] + } else { + set result $errorWithPrefix + } + testprofile cmdAH-4.4.13.$printable.tail convertto $enc $profile $prefix$str {*}$result + } + if {$ctrl eq {} || "middle" in $ctrl} { + if {$failidx == -1} { + set result [list $prefix_bytes$bytes$suffix_bytes] + } else { + set result $errorWithPrefix + } + testprofile cmdAH-4.4.13.$printable.middle convertto $enc $profile $prefix$str$suffix {*}$result } -} -body { - # Compile and execute - encoding_test -} -returnCodes 0 -result -1 -cleanup { - rename encoding_test "" } -test cmdAH-4.20.1 {convertrom -failindex with incomplete utf8} -body { - set x [encoding convertfrom -failindex i utf-8 A\xc3] - binary scan $x H* y - list $y $i -} -returnCodes 0 -result {41c3 -1} -test cmdAH-4.20.2 {convertrom -failindex with incomplete utf8 (byte compiled)} -setup { - proc encoding_test {} { - set x [encoding convertfrom -failindex i utf-8 A\xc3] - binary scan $x H* y - list $y $i + +# convertto -failindex ?-profile? - valid data +foreach {enc str hex ctrl comment} $encValidStrings { + if {"knownBug" in $ctrl} continue + set bytes [binary decode hex $hex] + set printable [printable $str] + set prefix A + set suffix B + set prefix_bytes [encoding convertto $enc A] + set suffix_bytes [encoding convertto $enc B] + foreach profile $encProfiles { + testfailindex cmdAH-4.4.14.$enc.$printable.solo convertto $enc $str $bytes -1 $profile + testfailindex cmdAH-4.4.14.$enc.$printable.lead convertto $enc $str$suffix $bytes$suffix_bytes -1 $profile + testfailindex cmdAH-4.4.14.$enc.$printable.tail convertto $enc $prefix$str $prefix_bytes$bytes -1 $profile + testfailindex cmdAH-4.4.14.$enc.$printable.middle convertto $enc $prefix$str$suffix $prefix_bytes$bytes$suffix_bytes -1 $profile } -} -body { - # Compile and execute - encoding_test -} -returnCodes 0 -result {41c3 -1} -cleanup { - rename encoding_test "" } -test cmdAH-4.21.1 {convertto -failindex with wrong character} -body { - set x [encoding convertto -failindex i iso8859-1 A\u0141] - binary scan $x H* y - list $y $i -} -returnCodes 0 -result {41 1} -test cmdAH-4.21.2 {convertto -failindex with wrong character (byte compiled)} -setup { - proc encoding_test {} { - set x [encoding convertto -failindex i iso8859-1 A\u0141] - binary scan $x H* y - list $y $i + +# convertto -failindex ?-profile? - invalid data +foreach {enc str profile hex failidx ctrl comment} $encUnencodableStrings { + if {"knownBug" in $ctrl} continue + set bytes [binary decode hex $hex] + set printable [printable $str] + set prefix A + set suffix B + set prefixLen [string length [encoding convertto $enc $prefix]] + if {$ctrl eq {} || "solo" in $ctrl} { + testfailindex cmdAH-4.4.14.$printable.solo convertto $enc $str $bytes $failidx $profile + } + if {$ctrl eq {} || "lead" in $ctrl} { + if {$failidx == -1} { + # If success expected + set result $bytes$suffix + } else { + # Failure expected + set result "" + } + testfailindex cmdAH-4.4.14.$printable.lead convertto $enc $str$suffix $result $failidx $profile + } + if {$ctrl eq {} || "tail" in $ctrl} { + set expected_failidx $failidx + if {$failidx == -1} { + # If success expected + set result $prefix$bytes + } else { + # Failure expected + set result $prefix + incr expected_failidx $prefixLen + } + testfailindex cmdAH-4.4.14.$printable.tail convertto $enc $prefix$str $result $expected_failidx $profile + } + if {$ctrl eq {} || "middle" in $ctrl} { + set expected_failidx $failidx + if {$failidx == -1} { + # If success expected + set result $prefix$bytes$suffix + } else { + # Failure expected + set result $prefix + incr expected_failidx $prefixLen + } + testfailindex cmdAH-4.4.14.$printable.middle convertto $enc $prefix$str$suffix $result $expected_failidx $profile } -} -body { - # Compile and execute - encoding_test -} -returnCodes 0 -result {41 1} -cleanup { - rename encoding_test "" } +test cmdAH-4.4.xx {convertto -profile strict} -constraints {testbytestring knownBug} -body { + # TODO - what does testbytestring even test? Invalid UTF8 in the Tcl_Obj bytes field + encoding convertto -profile strict utf-8 A[testbytestring \x80]B +} -returnCodes error -result {unexpected byte sequence starting at index 1: '\x80'} + +# +# encoding names 4.5.* +badnumargs cmdAH-4.5.1 {encoding names} {foo} +test cmdAH-4.5.2 {encoding names should include at least utf-8 and iso8859-1 and at least one more} -body { + set names [encoding names] + list [expr {"utf-8" in $names}] [expr {"iso8859-1" in $names}] [expr {[llength $names] > 2}] +} -result {1 1 1} + +# +# encoding profiles 4.6.* +badnumargs cmdAH-4.6.1 {encoding profiles} {foo} +test cmdAH-4.6.2 {encoding profiles} -body { + lsort [encoding profiles] +} -result {replace strict tcl8} + +# +# file command + test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body { file } -result {wrong # args: should be "file subcommand ?arg ...?"} @@ -439,19 +770,19 @@ test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform { test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname //foo -} / +} //foo test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname //foo/bar -} /foo +} //foo test cmdAH-8.16 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname {//foo\/bar/baz} -} {/foo\/bar} +} {//foo\/bar} test cmdAH-8.17 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname {//foo\/bar/baz/blat} -} {/foo\/bar/baz} +} {//foo\/bar/baz} test cmdAH-8.18 {Tcl_FileObjCmd: dirname} testsetplatform { testsetplatform unix file dirname /foo// @@ -583,7 +914,7 @@ test cmdAH-9.13 {Tcl_FileObjCmd: tail} testsetplatform { test cmdAH-9.14 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail //foo -} foo +} {} test cmdAH-9.15 {Tcl_FileObjCmd: tail} testsetplatform { testsetplatform unix file tail //foo/bar @@ -965,7 +1296,7 @@ test cmdAH-16.2 {Tcl_FileObjCmd: readable} { -result 1 } test cmdAH-16.3 {Tcl_FileObjCmd: readable} { - -constraints {unix notRoot testchmod} + -constraints {unix notRoot testchmod notWsl} -setup {testchmod 0o333 $gorpfile} -body {file readable $gorpfile} -result 0 @@ -998,7 +1329,7 @@ set gorpfile [makeFile abcde gorp.file] test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body { file executable a b } -result {wrong # args: should be "file executable name"} -test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} { +test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot notWsl} { file executable $gorpfile } 0 test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} { @@ -1410,7 +1741,7 @@ test cmdAH-24.14.1 { file mtime [file join [temporaryDirectory] CON.txt] } -match regexp -result {could not (?:get modification time|read)} -returnCodes error -# 3155760000 is 64-bit unix time, Wed Jan 01 00:00:00 GMT 2070: +# 3155760000 is 64-bit Unix time, Wed Jan 01 00:00:00 GMT 2070: test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { set filename [makeFile "" foo.text] } -body { @@ -1546,7 +1877,7 @@ test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup { file stat $gorpfile stat list $stat(nlink) $stat(size) $stat(type) } -result {1 12 file} -test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup { +test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix notWsl} -setup { unset -nocomplain stat } -body { file stat $gorpfile stat @@ -1819,7 +2150,7 @@ test cmdAH-32.5 {file tempfile - templates} -constraints unix -body { } -cleanup { catch {file delete $name} } -result ok -# Not portable; not all unix systems have mkstemps() +# Not portable; not all Unix systems have mkstemps() test cmdAH-32.6 {file tempfile - templates} -body { set template [file join $dirfile foo] close [file tempfile name $template.bar] diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 5a68925..316a945 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -137,7 +137,7 @@ test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body { } -result {expected integer but got "foo"} test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body { lsort -stride 1 bar -} -result {stride length must be at least 2} +} -match glob -result {stride length must be between 2 and *} test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body { lsort -stride 2 {a b c} } -result {list size must be a multiple of the stride length} @@ -168,6 +168,9 @@ test cmdIL-1.41 {lsort -stride and -index} -body { test cmdIL-1.42 {lsort -stride and-index} -body { lsort -stride 2 -index -1-1 {a 2 b 1} } -returnCodes error -result {index "-1-1" out of range} +test cmdIL-1.43 {lsort -stride errors} -returnCodes error -body { + lsort -stride 4294967296 bar +} -match glob -result {stride length must be between 2 and *} # Can't think of any good tests for the MergeSort and MergeLists procedures, # except a bunch of random lists to sort. diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index a7aa36c..89947bb 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -55,8 +55,8 @@ test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} -setup { file delete -force $foodir file mkdir $foodir cd $foodir -} -constraints {unix nonPortable} -body { - # This test fails on various unix platforms (eg Linux) where permissions +} -constraints {Unix nonPortable} -body { + # This test fails on various Unix platforms (eg Linux) where permissions # caching causes this to fail. The caching is strictly incorrect, but we # have no control over that. file attr . -permissions 0 diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index b70e65c..40dea76 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -280,10 +280,10 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -304,10 +304,10 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1 test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1 @@ -365,10 +365,10 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test compExpr-old-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test compExpr-old-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -387,10 +387,10 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test compExpr-old-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test compExpr-old-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test compExpr-old-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -418,10 +418,10 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body } -returnCodes error -match glob -result * test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -439,10 +439,10 @@ test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test compExpr-old-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test compExpr-old-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} { set a 27 @@ -590,6 +590,7 @@ test compExpr-old-15.5 {CompileMathFuncCall: not enough arguments} -body { test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * + test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { catch {unset a} set a(VALUE) ff15 diff --git a/tests/compile.test b/tests/compile.test index aec1ef1..36b4f3a 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -520,7 +520,7 @@ test compile-13.3 {TclCompileScript: testing check of max depth by nested script #puts $errors # all of nested calls exceed the limit, so must end with "too many nested compilations" # (or evaluations, depending on compile method/instruction and "mixed" compile within - # evaliation), so no one succeeds, the result must be empty: + # evaluation), so no one succeeds, the result must be empty: ti eval {set result} } -result {} # diff --git a/tests/dict.test b/tests/dict.test index d67f703..1515675 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -1109,7 +1109,7 @@ test dict-19.2 {dict: testing for leaks} -constraints memory -body { # This test is made to stress object reference management memtest { apply {{} { - # A shared invalid dictinary + # A shared invalid dictionary set apa {a {}b c d} set bepa $apa catch {dict replace $apa e f} diff --git a/tests/dstring.test b/tests/dstring.test index 11c5754..23863d0 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -211,6 +211,38 @@ test dstring-2.15 {appending list elements} -constraints testdstring -setup { } -cleanup { testdstring free } -result {x #} +test dstring-2.16 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup { + testdstring free +} -body { + testdstring element "\\\n"; # Will setfault + testdstring get +} -cleanup { + testdstring free +} -result \\\\\\n +test dstring-2.17 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup { + testdstring free +} -body { + testdstring element "\\\{"; # Will setfault + testdstring get +} -cleanup { + testdstring free +} -result [list [list \{]] +test dstring-2.18 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup { + testdstring free +} -body { + testdstring element "\\\}"; # Will setfault + testdstring get +} -cleanup { + testdstring free +} -result [list [list \}]] +test dstring-2.19 {appending list elements - bug [46dda6fc29] segfault} -constraints testdstring -setup { + testdstring free +} -body { + testdstring element "\\\\"; # Will setfault + testdstring get +} -cleanup { + testdstring free +} -result [list [list \\]] test dstring-3.1 {nested sublists} -constraints testdstring -setup { testdstring free @@ -473,6 +505,45 @@ test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body { } -cleanup { testdstring free } -result {{} {This is a specially-allocated stringz}} + +test dstring-7.1 {copying to Tcl_Obj} -constraints testdstring -setup { + testdstring free +} -body { + testdstring append xyz -1 + list [testdstring toobj] [testdstring length] +} -cleanup { + testdstring free +} -result {xyz 0} +test dstring-7.2 {copying to a Tcl_Obj} -constraints testdstring -setup { + testdstring free + unset -nocomplain a +} -body { + foreach l {a b c d e f g h i j k l m n o p} { + testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 + } + set a [testdstring toobj] + testdstring append abc -1 + list $a [testdstring get] +} -cleanup { + testdstring free +} -result {{aaaaaaaaaaaaaaaaaaaaa +bbbbbbbbbbbbbbbbbbbbb +ccccccccccccccccccccc +ddddddddddddddddddddd +eeeeeeeeeeeeeeeeeeeee +fffffffffffffffffffff +ggggggggggggggggggggg +hhhhhhhhhhhhhhhhhhhhh +iiiiiiiiiiiiiiiiiiiii +jjjjjjjjjjjjjjjjjjjjj +kkkkkkkkkkkkkkkkkkkkk +lllllllllllllllllllll +mmmmmmmmmmmmmmmmmmmmm +nnnnnnnnnnnnnnnnnnnnn +ooooooooooooooooooooo +ppppppppppppppppppppp +} abc} + # cleanup if {[testConstraint testdstring]} { diff --git a/tests/encoding.test b/tests/encoding.test index 6f11968..eb91a1d 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -22,7 +22,7 @@ catch { package require -exact tcl::test [info patchlevel] } -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] proc toutf {args} { variable x @@ -105,6 +105,14 @@ test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup { } -cleanup { fconfigure stdout -encoding $old } -result {jis0208} +test encoding-3.3 {fconfigure -profile} -setup { + set old [fconfigure stdout -profile] +} -body { + fconfigure stdout -profile replace + fconfigure stdout -profile +} -cleanup { + fconfigure stdout -profile $old +} -result replace test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup { cd [makeDirectory tmp] @@ -171,7 +179,7 @@ test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} { test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} { encoding convertfrom jis0208 8c8c8c8c -} "吾吾吾吾" +} 吾吾吾吾 test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} { set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C append a $a @@ -193,7 +201,7 @@ test encoding-8.1 {Tcl_ExternalToUtf} { close $f file delete [file join [temporaryDirectory] dummy] return $x -} "ab乎g" +} ab乎g test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} { encoding convertto jis0208 "吾吾吾吾" @@ -213,7 +221,7 @@ test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} { test encoding-10.1 {Tcl_UtfToExternal} { set f [open [file join [temporaryDirectory] dummy] w] fconfigure $f -translation binary -encoding shiftjis - puts -nonewline $f "ab乎g" + puts -nonewline $f ab乎g close $f set f [open [file join [temporaryDirectory] dummy] r] fconfigure $f -translation binary -encoding iso8859-1 @@ -248,7 +256,7 @@ test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} { } {1 {unknown encoding "jis0208"} 8C} test encoding-11.2 {LoadEncodingFile: single-byte} { encoding convertfrom jis0201 \xA1 -} "｡" +} ｡ test encoding-11.3 {LoadEncodingFile: double-byte} { encoding convertfrom jis0208 8C } 乎 @@ -299,7 +307,7 @@ test encoding-11.11 {encoding: extended Unicode UTF-32} { test encoding-12.1 {LoadTableEncoding: normal encoding} { set x [encoding convertto iso8859-3 Ġ] - append x [encoding convertto -nocomplain iso8859-3 Õ] + append x [encoding convertto -profile tcl8 iso8859-3 Õ] append x [encoding convertfrom iso8859-3 Õ] } "Õ?Ġ" test encoding-12.2 {LoadTableEncoding: single-byte encoding} { @@ -348,67 +356,67 @@ test encoding-15.5 {UtfToUtfProc emoji character input} { } "4 😂" test encoding-15.6 {UtfToUtfProc emoji character output} { set x \uDE02\uD83D\uDE02\uD83D - set y [encoding convertto -nocomplain utf-8 \uDE02\uD83D\uDE02\uD83D] + set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83D\uDE02\uD83D] binary scan $y H* z list [string length $y] $z } {10 edb882f09f9882eda0bd} test encoding-15.7 {UtfToUtfProc emoji character output} { set x \uDE02\uD83D\uD83D - set y [encoding convertto -nocomplain utf-8 \uDE02\uD83D\uD83D] + set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83D\uD83D] binary scan $y H* z list [string length $x] [string length $y] $z } {3 9 edb882eda0bdeda0bd} test encoding-15.8 {UtfToUtfProc emoji character output} { set x \uDE02\uD83Dé - set y [encoding convertto -nocomplain utf-8 \uDE02\uD83Dé] + set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83Dé] binary scan $y H* z list [string length $x] [string length $y] $z } {3 8 edb882eda0bdc3a9} test encoding-15.9 {UtfToUtfProc emoji character output} { set x \uDE02\uD83DX - set y [encoding convertto -nocomplain utf-8 \uDE02\uD83DX] + set y [encoding convertto -profile tcl8 utf-8 \uDE02\uD83DX] binary scan $y H* z list [string length $x] [string length $y] $z } {3 7 edb882eda0bd58} test encoding-15.10 {UtfToUtfProc high surrogate character output} { set x \uDE02é - set y [encoding convertto -nocomplain utf-8 \uDE02é] + set y [encoding convertto -profile tcl8 utf-8 \uDE02é] binary scan $y H* z list [string length $x] [string length $y] $z } {2 5 edb882c3a9} test encoding-15.11 {UtfToUtfProc low surrogate character output} { set x \uDA02é - set y [encoding convertto -nocomplain utf-8 \uDA02é] + set y [encoding convertto -profile tcl8 utf-8 \uDA02é] binary scan $y H* z list [string length $x] [string length $y] $z } {2 5 eda882c3a9} test encoding-15.12 {UtfToUtfProc high surrogate character output} { set x \uDE02Y - set y [encoding convertto -nocomplain utf-8 \uDE02Y] + set y [encoding convertto -profile tcl8 utf-8 \uDE02Y] binary scan $y H* z list [string length $x] [string length $y] $z } {2 4 edb88259} test encoding-15.13 {UtfToUtfProc low surrogate character output} { set x \uDA02Y - set y [encoding convertto -nocomplain utf-8 \uDA02Y] + set y [encoding convertto -profile tcl8 utf-8 \uDA02Y] binary scan $y H* z list [string length $x] [string length $y] $z } {2 4 eda88259} test encoding-15.14 {UtfToUtfProc high surrogate character output} { set x \uDE02 - set y [encoding convertto -nocomplain utf-8 \uDE02] + set y [encoding convertto -profile tcl8 utf-8 \uDE02] binary scan $y H* z list [string length $x] [string length $y] $z } {1 3 edb882} test encoding-15.15 {UtfToUtfProc low surrogate character output} { set x \uDA02 - set y [encoding convertto -nocomplain utf-8 \uDA02] + set y [encoding convertto -profile tcl8 utf-8 \uDA02] binary scan $y H* z list [string length $x] [string length $y] $z } {1 3 eda882} test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} { set x \xF0\xA0\xA1\xC2 - set y [encoding convertfrom -nocomplain utf-8 \xF0\xA0\xA1\xC2] + set y [encoding convertfrom -profile tcl8 utf-8 \xF0\xA0\xA1\xC2] list [string length $x] $y } "4 \xF0\xA0\xA1\xC2" test encoding-15.17 {UtfToUtfProc emoji character output} { @@ -452,6 +460,27 @@ test encoding-15.24 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} { binary scan $y H* z list [string length $y] $z } {2 cfbf} +test encoding-15.25 {UtfToUtfProc CESU-8} { + encoding convertfrom cesu-8 \x00 +} \x00 +test encoding-15.26 {UtfToUtfProc CESU-8} { + encoding convertfrom cesu-8 \xC0\x80 +} \x00 +test encoding-15.27 {UtfToUtfProc -profile strict CESU-8} { + encoding convertfrom -profile strict cesu-8 \x00 +} \x00 +test encoding-15.28 {UtfToUtfProc -profile strict CESU-8} -body { + encoding convertfrom -profile strict cesu-8 \xC0\x80 +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'} +test encoding-15.29 {UtfToUtfProc CESU-8} { + encoding convertto cesu-8 \x00 +} \x00 +test encoding-15.30 {UtfToUtfProc -profile strict CESU-8} { + encoding convertto -profile strict cesu-8 \x00 +} \x00 +test encoding-15.31 {UtfToUtfProc -profile strict CESU-8 (bytes F0-F4 are invalid)} -body { + encoding convertfrom -profile strict cesu-8 \xF1\x86\x83\x9C +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xF1'} test encoding-16.1 {Utf16ToUtfProc} -body { set val [encoding convertfrom utf-16 NN] @@ -481,31 +510,153 @@ test encoding-16.7 {Utf32ToUtfProc} -body { set val [encoding convertfrom utf-32be \0\0NN] list $val [format %x [scan $val %c]] } -result "乎 4e4e" +test encoding-16.8 {Utf32ToUtfProc} -body { + set val [encoding convertfrom -profile tcl8 utf-32 \x41\x00\x00\x41] + list $val [format %x [scan $val %c]] +} -result "\uFFFD fffd" +test encoding-16.9 {Utf32ToUtfProc} -body { + encoding convertfrom utf-32le \x00\xD8\x00\x00 +} -result \uD800 +test encoding-16.10 {Utf32ToUtfProc} -body { + encoding convertfrom utf-32le \x00\xDC\x00\x00 +} -result \uDC00 +test encoding-16.11 {Utf32ToUtfProc} -body { + encoding convertfrom utf-32le \x00\xD8\x00\x00\x00\xDC\x00\x00 +} -result \uD800\uDC00 +test encoding-16.12 {Utf32ToUtfProc} -body { + encoding convertfrom utf-32le \x00\xDC\x00\x00\x00\xD8\x00\x00 +} -result \uDC00\uD800 +test encoding-16.13 {Utf16ToUtfProc} -body { + encoding convertfrom utf-16le \x00\xD8 +} -result \uD800 +test encoding-16.14 {Utf16ToUtfProc} -body { + encoding convertfrom utf-16le \x00\xDC +} -result \uDC00 +test encoding-16.15 {Utf16ToUtfProc} -body { + encoding convertfrom utf-16le \x00\xD8\x00\xDC +} -result \uD800\uDC00 +test encoding-16.16 {Utf16ToUtfProc} -body { + encoding convertfrom utf-16le \x00\xDC\x00\xD8 +} -result \uDC00\uD800 +test encoding-16.17 {Utf32ToUtfProc} -body { + list [encoding convertfrom -profile strict -failindex idx utf-32le \x41\x00\x00\x00\x00\xD8\x00\x00\x42\x00\x00\x00] [set idx] +} -result {A 4} + +test encoding-16.18 { + Utf16ToUtfProc, Tcl_UniCharToUtf, surrogate pairs in utf-16 +} -body { + apply [list {} { + for {set i 0xD800} {$i < 0xDBFF} {incr i} { + for {set j 0xDC00} {$j < 0xDFFF} {incr j} { + set string [binary format S2 [list $i $j]] + set status [catch { + set decoded [encoding convertfrom utf-16be $string] + set encoded [encoding convertto utf-16be $decoded] + }] + if {$status || ( $encoded ne $string )} { + return [list [format %x $i] [format %x $j]] + } + } + } + return done + } [namespace current]] +} -result done +test encoding-16.19 {Utf16ToUtfProc, bug [d19fe0a5b]} -body { + encoding convertfrom utf-16 "\x41\x41\x41" +} -result \u4141\uFFFD +test encoding-16.20 {Utf16ToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body { + encoding convertfrom utf-16 "\xD8\xD8" +} -result \uD8D8 +test encoding-16.21 {Utf16ToUtfProc, bug [d19fe0a5b]} -body { + encoding convertfrom utf-32 "\x00\x00\x00\x00\x41\x41" +} -result \x00\uFFFD +test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body { + encoding convertfrom -profile strict utf-16le \x00\xD8 +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'} +test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body { + encoding convertfrom -profile strict utf-16le \x00\xDC +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'} +test encoding-16.24 {Utf32ToUtfProc} -body { + encoding convertfrom utf-32 "\xFF\xFF\xFF\xFF" +} -result \uFFFD +test encoding-16.25 {Utf32ToUtfProc} -body { + encoding convertfrom utf-32 "\x01\x00\x00\x01" +} -result \uFFFD test encoding-17.1 {UtfToUtf16Proc} -body { encoding convertto utf-16 "\U460DC" } -result "\xD8\xD8\xDC\xDC" -test encoding-17.2 {UtfToUcs2Proc} -body { +test encoding-17.2 {UtfToUcs2Proc, invalid testcase, see [5607d6482c]} -constraints deprecated -body { encoding convertfrom utf-16 [encoding convertto ucs-2 "\U460DC"] } -result "\uFFFD" test encoding-17.3 {UtfToUtf16Proc} -body { - encoding convertto -nocomplain utf-16be "\uDCDC" -} -result "\xFF\xFD" + encoding convertto -profile tcl8 utf-16be "\uDCDC" +} -result "\xDC\xDC" test encoding-17.4 {UtfToUtf16Proc} -body { - encoding convertto -nocomplain utf-16le "\uD8D8" -} -result "\xFD\xFF" + encoding convertto -profile tcl8 utf-16le "\uD8D8" +} -result "\xD8\xD8" test encoding-17.5 {UtfToUtf16Proc} -body { encoding convertto utf-32le "\U460DC" } -result "\xDC\x60\x04\x00" test encoding-17.6 {UtfToUtf16Proc} -body { encoding convertto utf-32be "\U460DC" } -result "\x00\x04\x60\xDC" +test encoding-17.7 {UtfToUtf16Proc} -body { + encoding convertto -profile strict utf-16be "\uDCDC" +} -returnCodes error -result {unexpected character at index 0: 'U+00DCDC'} +test encoding-17.8 {UtfToUtf16Proc} -body { + encoding convertto -profile strict utf-16le "\uD8D8" +} -returnCodes error -result {unexpected character at index 0: 'U+00D8D8'} +test encoding-17.9 {Utf32ToUtfProc} -body { + encoding convertfrom -profile strict utf-32 "\xFF\xFF\xFF\xFF" +} -returnCodes error -result {unexpected byte sequence starting at index 0: '\xFF'} +test encoding-17.10 {Utf32ToUtfProc} -body { + encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF" +} -result \uFFFD +test encoding-17.11 {Utf32ToUtfProc} -body { + encoding convertfrom -profile strict utf-32le "\x00\xD8\x00\x00" +} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'} +test encoding-17.12 {Utf32ToUtfProc} -body { + encoding convertfrom -profile strict utf-32le "\x00\xDC\x00\x00" +} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'} -test encoding-18.1 {TableToUtfProc} { -} {} +test encoding-18.1 {TableToUtfProc on invalid input} -constraints deprecated -body { + list [catch {encoding convertto jis0208 \\} res] $res +} -result {0 !)} +test encoding-18.2 {TableToUtfProc on invalid input with -profile strict} -body { + list [catch {encoding convertto -profile strict jis0208 \\} res] $res +} -result {1 {unexpected character at index 0: 'U+00005C'}} +test encoding-18.3 {TableToUtfProc on invalid input with -profile strict -failindex} -body { + list [catch {encoding convertto -profile strict -failindex pos jis0208 \\} res] $res $pos +} -result {0 {} 0} +test encoding-18.4 {TableToUtfProc on invalid input with -failindex -profile strict} -body { + list [catch {encoding convertto -failindex pos -profile strict jis0208 \\} res] $res $pos +} -result {0 {} 0} +test encoding-18.5 {TableToUtfProc on invalid input with -failindex} -body { + list [catch {encoding convertto -failindex pos jis0208 \\} res] $res $pos +} -result {0 !) -1} +test encoding-18.6 {TableToUtfProc on invalid input with -profile tcl8} -body { + list [catch {encoding convertto -profile tcl8 jis0208 \\} res] $res +} -result {0 !)} -test encoding-19.1 {TableFromUtfProc} { -} {} +test encoding-19.1 {TableFromUtfProc} -body { + encoding convertfrom ascii AÁ +} -result AÁ +test encoding-19.2 {TableFromUtfProc} -body { + encoding convertfrom -profile tcl8 ascii AÁ +} -result AÁ +test encoding-19.3 {TableFromUtfProc} -body { + encoding convertfrom -profile strict ascii AÁ +} -returnCodes 1 -result {unexpected byte sequence starting at index 1: '\xC1'} +test encoding-19.4 {TableFromUtfProc} -body { + list [encoding convertfrom -failindex idx ascii AÁ] [set idx] +} -result [list A\xC1 -1] +test encoding-19.5 {TableFromUtfProc} -body { + list [encoding convertfrom -failindex idx -profile strict ascii A\xC1] [set idx] +} -result {A 1} +test encoding-19.6 {TableFromUtfProc} -body { + list [encoding convertfrom -failindex idx -profile strict ascii AÁB] [set idx] +} -result {A 1} test encoding-20.1 {TableFreefProc} { } {} @@ -617,25 +768,25 @@ 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 -nocomplain utf-8 "\xC0\x81"] + string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"] } 2 test encoding-24.6 {Parse valid or invalid utf-8} { - string length [encoding convertfrom -nocomplain utf-8 "\xC1\xBF"] + string length [encoding convertfrom -profile tcl8 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 -nocomplain utf-8 "\xE0\x80\x80"] + string length [encoding convertfrom -profile tcl8 utf-8 "\xE0\x80\x80"] } 3 test encoding-24.9 {Parse valid or invalid utf-8} { - string length [encoding convertfrom -nocomplain utf-8 "\xE0\x9F\xBF"] + string length [encoding convertfrom -profile tcl8 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 -nocomplain utf-8 "\xEF\xBF\xBF"] + string length [encoding convertfrom -profile tcl8 utf-8 "\xEF\xBF\xBF"] } 1 test encoding-24.12 {Parse valid or invalid utf-8} -constraints deprecated -body { encoding convertfrom utf-8 "\xC0\x81" @@ -648,7 +799,7 @@ test encoding-24.14 {Parse valid or invalid utf-8} { } 1 test encoding-24.15 {Parse valid or invalid utf-8} -constraints deprecated -body { encoding convertfrom utf-8 "Z\xE0\x80" -} -result Z\xE0\x80 +} -result Z\xE0\u20AC test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body { encoding convertto utf-8 [testbytestring "Z\u4343\x80"] } -returnCodes 1 -result {expected byte sequence but character 1 was '䍃' (U+004343)} @@ -661,18 +812,84 @@ test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring - test encoding-24.19 {Parse valid or invalid utf-8} -constraints deprecated -body { encoding convertto utf-8 "ZX\uD800" } -result ZX\xED\xA0\x80 -test encoding-24.20 {Parse with -nocomplain but without providing encoding} { - string length [encoding convertfrom -nocomplain "\x20"] -} 1 -test encoding-24.21 {Parse with -nocomplain but without providing encoding} { - string length [encoding convertto -nocomplain "\x20"] -} 1 +test encoding-24.20 {Parse with -profile tcl8 but without providing encoding} -body { + encoding convertfrom -profile tcl8 "\x20" +} -result {wrong # args: should be "::tcl::encoding::convertfrom ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertfrom data"} -returnCodes error +test encoding-24.21 {Parse with -profile tcl8 but without providing encoding} -body { + string length [encoding convertto -profile tcl8 "\x20"] +} -result {wrong # args: should be "::tcl::encoding::convertto ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertto data"} -returnCodes error test encoding-24.22 {Syntax error, two encodings} -body { encoding convertfrom iso8859-1 utf-8 "ZX\uD800" -} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} +} -result {bad option "iso8859-1": must be -profile or -failindex} -returnCodes error test encoding-24.23 {Syntax error, two encodings} -body { encoding convertto iso8859-1 utf-8 "ZX\uD800" -} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain? ?-failindex var? ?encoding? data"} +} -result {bad option "iso8859-1": must be -profile or -failindex} -returnCodes error +test encoding-24.24 {Parse invalid utf-8 with -profile strict} -body { + encoding convertfrom -profile strict utf-8 "\xC0\x80\x00\x00" +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'} +test encoding-24.25 {Parse invalid utf-8 with -profile strict} -body { + encoding convertfrom -profile strict utf-8 "\x40\x80\x00\x00" +} -returnCodes 1 -result {unexpected byte sequence starting at index 1: '\x80'} +test encoding-24.26 {Parse valid utf-8 with -profile strict} -body { + encoding convertfrom -profile strict utf-8 "\xF1\x80\x80\x80" +} -result \U40000 +test encoding-24.27 {Parse invalid utf-8 with -profile strict} -body { + encoding convertfrom -profile strict utf-8 "\xF0\x80\x80\x80" +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xF0'} +test encoding-24.28 {Parse invalid utf-8 with -profile strict} -body { + encoding convertfrom -profile strict utf-8 "\xFF\x00\x00" +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xFF'} +test encoding-24.29 {Parse invalid utf-8} -body { + encoding convertfrom utf-8 \xEF\xBF\xBF +} -result \uFFFF +test encoding-24.30 {Parse noncharacter with -profile strict} -body { + encoding convertfrom -profile strict utf-8 \xEF\xBF\xBF +} -result \uFFFF +test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body { + encoding convertfrom -profile tcl8 utf-8 \xEF\xBF\xBF +} -result \uFFFF +test encoding-24.32 {Try to generate invalid utf-8} -body { + encoding convertto utf-8 \uFFFF +} -result \xEF\xBF\xBF +test encoding-24.33 {Try to generate noncharacter with -profile strict} -body { + encoding convertto -profile strict utf-8 \uFFFF +} -result \xEF\xBF\xBF +test encoding-24.34 {Try to generate invalid utf-8 with -profile tcl8} -body { + encoding convertto -profile tcl8 utf-8 \uFFFF +} -result \xEF\xBF\xBF +test encoding-24.35 {Parse invalid utf-8} -constraints deprecated -body { + encoding convertfrom utf-8 \xED\xA0\x80 +} -result \uD800 +test encoding-24.36 {Parse invalid utf-8 with -profile strict} -body { + encoding convertfrom -profile strict utf-8 \xED\xA0\x80 +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xED'} +test encoding-24.37 {Parse invalid utf-8 with -profile tcl8} -body { + encoding convertfrom -profile tcl8 utf-8 \xED\xA0\x80 +} -result \uD800 +test encoding-24.38 {Try to generate invalid utf-8} -constraints deprecated -body { + encoding convertto utf-8 \uD800 +} -result \xED\xA0\x80 +test encoding-24.39 {Try to generate invalid utf-8 with -profile strict} -body { + encoding convertto -profile strict utf-8 \uD800 +} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'} +test encoding-24.40 {Try to generate invalid utf-8 with -profile tcl8} -body { + encoding convertto -profile tcl8 utf-8 \uD800 +} -result \xED\xA0\x80 +test encoding-24.41 {Parse invalid utf-8 with -profile strict} -body { + encoding convertfrom -profile strict utf-8 \xED\xA0\x80\xED\xB0\x80 +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xED'} +test encoding-24.42 {Parse invalid utf-8, fallback to cp1252 [885c86a9a0]} -body { + encoding convertfrom -profile tcl8 utf-8 \xF0\x80\x80\x80 +} -result \xF0\u20AC\u20AC\u20AC +test encoding-24.43 {Parse invalid utf-8, fallback to cp1252 [885c86a9a0]} -body { + encoding convertfrom -profile tcl8 utf-8 \x80 +} -result \u20AC +test encoding-24.44 {Try to generate invalid ucs-2 with -profile strict} -body { + encoding convertto -profile strict ucs-2 \uD800 +} -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'} +test encoding-24.45 {Try to generate invalid ucs-2 with -profile strict} -body { + encoding convertto -profile strict ucs-2 \U10000 +} -returnCodes 1 -result {unexpected character at index 0: 'U+010000'} file delete [file join [temporaryDirectory] iso2022.txt] @@ -827,20 +1044,72 @@ test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body { test encoding-28.0 {all encodings load} -body { set string hello foreach name [encoding names] { - incr count - encoding convertto -nocomplain $name $string + if {$name ne "unicode"} { + incr count + } + encoding convertto -profile tcl8 $name $string # discard the cached internal representation of Tcl_Encoding # Unfortunately, without this, encoding 2-1 fails. llength $name } return $count -} -result [expr {[info exists ::tcl_precision] ? 92 : 91}] +} -result 91 runtests +test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { + testencoding +} -body { + # Note - buffers are initialized to \xff + list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1} result] $result +} -result [list 0 [list nospace {} \xff]] + +test encoding-bug-183a1adcc0-2 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { + testencoding +} -body { + # Note - buffers are initialized to \xff + list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 0} result] $result +} -result [list 0 [list nospace {} {}]] + +test encoding-bug-183a1adcc0-3 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { + testencoding +} -body { + # Note - buffers are initialized to \xff + list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 2} result] $result +} -result [list 0 [list nospace {} \x00\x00]] + +test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { + testencoding +} -body { + # Note - buffers are initialized to \xff + list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 3} result] $result +} -result [list 0 [list nospace {} \x00\x00\xff]] + +test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints { + testencoding ucs2 knownBug +} -body { + # The knownBug constraint is because test depends on TCL_UTF_MAX and + # also UtfToUtf16 assumes space required in destination buffer is + # sizeof(Tcl_UniChar) which is incorrect when TCL_UTF_MAX==4 + # Note - buffers are initialized to \xff + list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 4} result] $result +} -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]] + } +test encoding-29.0 {get encoding nul terminator lengths} -constraints { + testencoding +} -body { + list \ + [testencoding nullength ascii] \ + [testencoding nullength utf-16] \ + [testencoding nullength utf-32] \ + [testencoding nullength gb12345] \ + [testencoding nullength ksc5601] +} -result {1 2 4 2 2} + + # cleanup namespace delete ::tcl::test::encoding ::tcltest::cleanupTests diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl new file mode 100644 index 0000000..986e221 --- /dev/null +++ b/tests/encodingVectors.tcl @@ -0,0 +1,655 @@ +# This file contains test vectors for verifying various encodings. They are +# stored in a common file so that they can be sourced into the various test +# modules that are dependent on encodings. This file contains statically defined +# test vectors. In addition, it sources the ICU-generated test vectors from +# icuUcmTests.tcl. +# +# Note that sourcing the file will reinitialize any existing encoding test +# vectors. +# + +# List of defined encoding profiles +set encProfiles {tcl8 strict replace} +set encDefaultProfile tcl8; # Should reflect the default from implementation + +# encValidStrings - Table of valid strings. +# +# Each row is <ENCODING STR BYTES CTRL COMMENT> +# The pair <ENCODING,STR> should be unique for generated test ids to be unique. +# STR is a string that can be encoded in the encoding ENCODING resulting +# in the byte sequence BYTES. The CTRL field is a list that controls test +# generation. It may contain zero or more of `solo`, `lead`, `tail` and +# `middle` indicating that the generated tests should include the string +# by itself, as the lead of a longer string, as the tail of a longer string +# and in the middle of a longer string. If CTRL is empty, it is treated as +# containing all four of the above. The CTRL field may also contain the +# words knownBug or knownW3C which will cause the test generation for that +# vector to be skipped. +# +# utf-16, utf-32 missing because they are automatically +# generated based on le/be versions. +set encValidStrings {}; # Reset the table + +lappend encValidStrings {*}{ + ascii \u0000 00 {} {Lowest ASCII} + ascii \u007F 7F knownBug {Highest ASCII} + ascii \u007D 7D {} {Brace - just to verify test scripts are escaped correctly} + ascii \u007B 7B {} {Terminating brace - just to verify test scripts are escaped correctly} + + utf-8 \u0000 00 {} {Unicode Table 3.7 Row 1} + utf-8 \u007F 7F {} {Unicode Table 3.7 Row 1} + utf-8 \u0080 C280 {} {Unicode Table 3.7 Row 2} + utf-8 \u07FF DFBF {} {Unicode Table 3.7 Row 2} + utf-8 \u0800 E0A080 {} {Unicode Table 3.7 Row 3} + utf-8 \u0FFF E0BFBF {} {Unicode Table 3.7 Row 3} + utf-8 \u1000 E18080 {} {Unicode Table 3.7 Row 4} + utf-8 \uCFFF ECBFBF {} {Unicode Table 3.7 Row 4} + utf-8 \uD000 ED8080 {} {Unicode Table 3.7 Row 5} + utf-8 \uD7FF ED9FBF {} {Unicode Table 3.7 Row 5} + utf-8 \uE000 EE8080 {} {Unicode Table 3.7 Row 6} + utf-8 \uFFFF EFBFBF {} {Unicode Table 3.7 Row 6} + utf-8 \U10000 F0908080 {} {Unicode Table 3.7 Row 7} + utf-8 \U3FFFF F0BFBFBF {} {Unicode Table 3.7 Row 7} + utf-8 \U40000 F1808080 {} {Unicode Table 3.7 Row 8} + utf-8 \UFFFFF F3BFBFBF {} {Unicode Table 3.7 Row 8} + utf-8 \U100000 F4808080 {} {Unicode Table 3.7 Row 9} + utf-8 \U10FFFF F48FBFBF {} {Unicode Table 3.7 Row 9} + utf-8 A\u03A9\u8A9E\U00010384 41CEA9E8AA9EF0908E84 {} {Unicode 2.5} + + utf-16le \u0000 0000 {} {Lowest code unit} + utf-16le \uD7FF FFD7 {} {Below high surrogate range} + utf-16le \uE000 00E0 {} {Above low surrogate range} + utf-16le \uFFFF FFFF {} {Highest code unit} + utf-16le \U010000 00D800DC {} {First surrogate pair} + utf-16le \U10FFFF FFDBFFDF {} {First surrogate pair} + utf-16le A\u03A9\u8A9E\U00010384 4100A9039E8A00D884DF {} {Unicode 2.5} + + utf-16be \u0000 0000 {} {Lowest code unit} + utf-16be \uD7FF D7FF {} {Below high surrogate range} + utf-16be \uE000 E000 {} {Above low surrogate range} + utf-16be \uFFFF FFFF {} {Highest code unit} + utf-16be \U010000 D800DC00 {} {First surrogate pair} + utf-16be \U10FFFF DBFFDFFF {} {First surrogate pair} + utf-16be A\u03A9\u8A9E\U00010384 004103A98A9ED800DF84 {} {Unicode 2.5} + + utf-32le \u0000 00000000 {} {Lowest code unit} + utf-32le \uFFFF FFFF0000 {} {Highest BMP} + utf-32le \U010000 00000100 {} {First supplementary} + utf-32le \U10FFFF ffff1000 {} {Last supplementary} + utf-32le A\u03A9\u8A9E\U00010384 41000000A90300009E8A000084030100 {} {Unicode 2.5} + + utf-32be \u0000 00000000 {} {Lowest code unit} + utf-32be \uFFFF 0000FFFF {} {Highest BMP} + utf-32be \U010000 00010000 {} {First supplementary} + utf-32be \U10FFFF 0010FFFF {} {Last supplementary} + utf-32be A\u03A9\u8A9E\U00010384 00000041000003A900008A9E00010384 {} {Unicode 2.5} +} + +# encInvalidBytes - Table of invalid byte sequences +# These are byte sequences that should appear for an encoding. Each row is +# of the form +# <ENCODING BYTES PROFILE EXPECTEDRESULT EXPECTEDFAILINDEX CTRL COMMENT> +# The triple <ENCODING,BYTES,PROFILE> should be unique for test ids to be +# unique. BYTES is a byte sequence that is invalid. EXPECTEDRESULT is the +# expected string when the bytes are decoded using the PROFILE profile. +# FAILINDEX gives the expected index of the invalid byte under that profile. The +# CTRL field is a list that controls test generation. It may contain zero or +# more of `solo`, `lead`, `tail` and `middle` indicating that the generated the +# tail of a longer and in the middle of a longer string. If empty, it is treated +# as containing all four of the above. The CTRL field may also contain the words +# knownBug or knownW3C which will cause the test generation for that vector to +# be skipped. +# +# utf-32 missing because they are automatically generated based on le/be +# versions. +set encInvalidBytes {}; # Reset the table + +# ascii - Any byte above 127 is invalid and is mapped +# to the same numeric code point except for the range +# 80-9F which is treated as cp1252. +# This tests the TableToUtfProc code path. +lappend encInvalidBytes {*}{ + ascii 80 tcl8 \u20AC -1 {knownBug} {map to cp1252} + ascii 80 replace \uFFFD -1 {} {Smallest invalid byte} + ascii 80 strict {} 0 {} {Smallest invalid byte} + ascii 81 tcl8 \u0081 -1 {knownBug} {map to cp1252} + ascii 82 tcl8 \u201A -1 {knownBug} {map to cp1252} + ascii 83 tcl8 \u0192 -1 {knownBug} {map to cp1252} + ascii 84 tcl8 \u201E -1 {knownBug} {map to cp1252} + ascii 85 tcl8 \u2026 -1 {knownBug} {map to cp1252} + ascii 86 tcl8 \u2020 -1 {knownBug} {map to cp1252} + ascii 87 tcl8 \u2021 -1 {knownBug} {map to cp1252} + ascii 88 tcl8 \u0276 -1 {knownBug} {map to cp1252} + ascii 89 tcl8 \u2030 -1 {knownBug} {map to cp1252} + ascii 8A tcl8 \u0160 -1 {knownBug} {map to cp1252} + ascii 8B tcl8 \u2039 -1 {knownBug} {map to cp1252} + ascii 8C tcl8 \u0152 -1 {knownBug} {map to cp1252} + ascii 8D tcl8 \u008D -1 {knownBug} {map to cp1252} + ascii 8E tcl8 \u017D -1 {knownBug} {map to cp1252} + ascii 8F tcl8 \u008F -1 {knownBug} {map to cp1252} + ascii 90 tcl8 \u0090 -1 {knownBug} {map to cp1252} + ascii 91 tcl8 \u2018 -1 {knownBug} {map to cp1252} + ascii 92 tcl8 \u2019 -1 {knownBug} {map to cp1252} + ascii 93 tcl8 \u201C -1 {knownBug} {map to cp1252} + ascii 94 tcl8 \u201D -1 {knownBug} {map to cp1252} + ascii 95 tcl8 \u2022 -1 {knownBug} {map to cp1252} + ascii 96 tcl8 \u2013 -1 {knownBug} {map to cp1252} + ascii 97 tcl8 \u2014 -1 {knownBug} {map to cp1252} + ascii 98 tcl8 \u02DC -1 {knownBug} {map to cp1252} + ascii 99 tcl8 \u2122 -1 {knownBug} {map to cp1252} + ascii 9A tcl8 \u0161 -1 {knownBug} {map to cp1252} + ascii 9B tcl8 \u203A -1 {knownBug} {map to cp1252} + ascii 9C tcl8 \u0153 -1 {knownBug} {map to cp1252} + ascii 9D tcl8 \u009D -1 {knownBug} {map to cp1252} + ascii 9E tcl8 \u017E -1 {knownBug} {map to cp1252} + ascii 9F tcl8 \u0178 -1 {knownBug} {map to cp1252} + + ascii FF tcl8 \u00FF -1 {} {Largest invalid byte} + ascii FF replace \uFFFD -1 {} {Largest invalid byte} + ascii FF strict {} 0 {} {Largest invalid byte} +} + +# utf-8 - valid sequences based on Table 3.7 in the Unicode +# standard. +# +# Code Points First Second Third Fourth Byte +# U+0000..U+007F 00..7F +# U+0080..U+07FF C2..DF 80..BF +# U+0800..U+0FFF E0 A0..BF 80..BF +# U+1000..U+CFFF E1..EC 80..BF 80..BF +# U+D000..U+D7FF ED 80..9F 80..BF +# U+E000..U+FFFF EE..EF 80..BF 80..BF +# U+10000..U+3FFFF F0 90..BF 80..BF 80..BF +# U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF +# U+100000..U+10FFFF F4 80..8F 80..BF 80..BF +# +# Tests below are based on the "gaps" in the above table. Note ascii test +# values are repeated because internally a different code path is used +# (UtfToUtfProc). +# Note C0, C1, F5:FF are invalid bytes ANYWHERE. Exception is C080 +lappend encInvalidBytes {*}{ + utf-8 80 tcl8 \u20AC -1 {} {map to cp1252} + utf-8 80 replace \uFFFD -1 {} {Smallest invalid byte} + utf-8 80 strict {} 0 {} {Smallest invalid byte} + utf-8 81 tcl8 \u0081 -1 {} {map to cp1252} + utf-8 82 tcl8 \u201A -1 {} {map to cp1252} + utf-8 83 tcl8 \u0192 -1 {} {map to cp1252} + utf-8 84 tcl8 \u201E -1 {} {map to cp1252} + utf-8 85 tcl8 \u2026 -1 {} {map to cp1252} + utf-8 86 tcl8 \u2020 -1 {} {map to cp1252} + utf-8 87 tcl8 \u2021 -1 {} {map to cp1252} + utf-8 88 tcl8 \u02C6 -1 {} {map to cp1252} + utf-8 89 tcl8 \u2030 -1 {} {map to cp1252} + utf-8 8A tcl8 \u0160 -1 {} {map to cp1252} + utf-8 8B tcl8 \u2039 -1 {} {map to cp1252} + utf-8 8C tcl8 \u0152 -1 {} {map to cp1252} + utf-8 8D tcl8 \u008D -1 {} {map to cp1252} + utf-8 8E tcl8 \u017D -1 {} {map to cp1252} + utf-8 8F tcl8 \u008F -1 {} {map to cp1252} + utf-8 90 tcl8 \u0090 -1 {} {map to cp1252} + utf-8 91 tcl8 \u2018 -1 {} {map to cp1252} + utf-8 92 tcl8 \u2019 -1 {} {map to cp1252} + utf-8 93 tcl8 \u201C -1 {} {map to cp1252} + utf-8 94 tcl8 \u201D -1 {} {map to cp1252} + utf-8 95 tcl8 \u2022 -1 {} {map to cp1252} + utf-8 96 tcl8 \u2013 -1 {} {map to cp1252} + utf-8 97 tcl8 \u2014 -1 {} {map to cp1252} + utf-8 98 tcl8 \u02DC -1 {} {map to cp1252} + utf-8 99 tcl8 \u2122 -1 {} {map to cp1252} + utf-8 9A tcl8 \u0161 -1 {} {map to cp1252} + utf-8 9B tcl8 \u203A -1 {} {map to cp1252} + utf-8 9C tcl8 \u0153 -1 {} {map to cp1252} + utf-8 9D tcl8 \u009D -1 {} {map to cp1252} + utf-8 9E tcl8 \u017E -1 {} {map to cp1252} + utf-8 9F tcl8 \u0178 -1 {} {map to cp1252} + + utf-8 C0 tcl8 \u00C0 -1 {} {C0 is invalid anywhere} + utf-8 C0 strict {} 0 {} {C0 is invalid anywhere} + utf-8 C0 replace \uFFFD -1 {} {C0 is invalid anywhere} + utf-8 C080 tcl8 \u0000 -1 {} {C080 -> U+0 in Tcl's internal modified UTF8} + utf-8 C080 strict {} 0 {} {C080 -> invalid} + utf-8 C080 replace \uFFFD -1 {} {C080 -> single replacement char} + utf-8 C0A2 tcl8 \u00C0\u00A2 -1 {} {websec.github.io - A} + utf-8 C0A2 replace \uFFFD\uFFFD -1 {} {websec.github.io - A} + utf-8 C0A2 strict {} 0 {} {websec.github.io - A} + utf-8 C0A7 tcl8 \u00C0\u00A7 -1 {} {websec.github.io - double quote} + utf-8 C0A7 replace \uFFFD\uFFFD -1 {} {websec.github.io - double quote} + utf-8 C0A7 strict {} 0 {} {websec.github.io - double quote} + utf-8 C0AE tcl8 \u00C0\u00AE -1 {} {websec.github.io - full stop} + utf-8 C0AE replace \uFFFD\uFFFD -1 {} {websec.github.io - full stop} + utf-8 C0AE strict {} 0 {} {websec.github.io - full stop} + utf-8 C0AF tcl8 \u00C0\u00AF -1 {} {websec.github.io - solidus} + utf-8 C0AF replace \uFFFD\uFFFD -1 {} {websec.github.io - solidus} + utf-8 C0AF strict {} 0 {} {websec.github.io - solidus} + + utf-8 C1 tcl8 \u00C1 -1 {} {C1 is invalid everywhere} + utf-8 C1 replace \uFFFD -1 {} {C1 is invalid everywhere} + utf-8 C1 strict {} 0 {} {C1 is invalid everywhere} + utf-8 C181 tcl8 \u00C1\u0081 -1 {} {websec.github.io - base test (A)} + utf-8 C181 replace \uFFFD\uFFFD -1 {} {websec.github.io - base test (A)} + utf-8 C181 strict {} 0 {} {websec.github.io - base test (A)} + utf-8 C19C tcl8 \u00C1\u0153 -1 {} {websec.github.io - reverse solidus} + utf-8 C19C replace \uFFFD\uFFFD -1 {} {websec.github.io - reverse solidus} + utf-8 C19C strict {} 0 {} {websec.github.io - reverse solidus} + + utf-8 C2 tcl8 \u00C2 -1 {} {Missing trail byte} + utf-8 C2 replace \uFFFD -1 {} {Missing trail byte} + utf-8 C2 strict {} 0 {} {Missing trail byte} + utf-8 C27F tcl8 \u00C2\x7F -1 {} {Trail byte must be 80:BF} + utf-8 C27F replace \uFFFD\x7F -1 {} {Trail byte must be 80:BF} + utf-8 C27F strict {} 0 {} {Trail byte must be 80:BF} + utf-8 DF tcl8 \u00DF -1 {} {Missing trail byte} + utf-8 DF replace \uFFFD -1 {} {Missing trail byte} + utf-8 DF strict {} 0 {} {Missing trail byte} + utf-8 DF7F tcl8 \u00DF\x7F -1 {} {Trail byte must be 80:BF} + utf-8 DF7F replace \uFFFD\x7F -1 {} {Trail byte must be 80:BF} + utf-8 DF7F strict {} 0 {} {Trail byte must be 80:BF} + utf-8 DFE0A080 tcl8 \u00DF\u0800 -1 {} {Invalid trail byte is start of valid sequence} + utf-8 DFE0A080 replace \uFFFD\u0800 -1 {} {Invalid trail byte is start of valid sequence} + utf-8 DFE0A080 strict {} 0 {} {Invalid trail byte is start of valid sequence} + + utf-8 E0 tcl8 \u00E0 -1 {} {Missing trail byte} + utf-8 E0 replace \uFFFD -1 {} {Missing trail byte} + utf-8 E0 strict {} 0 {} {Missing trail byte} + utf-8 E080 tcl8 \u00E0\u20AC -1 {} {First trail byte must be A0:BF} + utf-8 E080 replace \uFFFD\uFFFD -1 {} {First trail byte must be A0:BF} + utf-8 E080 strict {} 0 {} {First trail byte must be A0:BF} + utf-8 E0819C tcl8 \u00E0\u0081\u0153 -1 {} {websec.github.io - reverse solidus} + utf-8 E0819C replace \uFFFD\uFFFD\uFFFD -1 {} {websec.github.io - reverse solidus} + utf-8 E0819C strict {} 0 {} {websec.github.io - reverse solidus} + utf-8 E09F tcl8 \u00E0\u0178 -1 {} {First trail byte must be A0:BF} + utf-8 E09F replace \uFFFD\uFFFD -1 {} {First trail byte must be A0:BF} + utf-8 E09F strict {} 0 {} {First trail byte must be A0:BF} + utf-8 E0A0 tcl8 \u00E0\u00A0 -1 {} {Missing second trail byte} + utf-8 E0A0 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 E0A0 strict {} 0 {} {Missing second trail byte} + utf-8 E0BF tcl8 \u00E0\u00BF -1 {} {Missing second trail byte} + utf-8 E0BF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 E0BF strict {} 0 {} {Missing second trail byte} + utf-8 E0A07F tcl8 \u00E0\u00A0\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 E0A07F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 E0A07F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 E0BF7F tcl8 \u00E0\u00BF\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 E0BF7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 E0BF7F strict {} 0 {} {Second trail byte must be 80:BF} + + utf-8 E1 tcl8 \u00E1 -1 {} {Missing trail byte} + utf-8 E1 replace \uFFFD -1 {} {Missing trail byte} + utf-8 E1 strict {} 0 {} {Missing trail byte} + utf-8 E17F tcl8 \u00E1\x7F -1 {} {Trail byte must be 80:BF} + utf-8 E17F replace \uFFFD\x7F -1 {} {Trail byte must be 80:BF} + utf-8 E17F strict {} 0 {} {Trail byte must be 80:BF} + utf-8 E181 tcl8 \u00E1\u0081 -1 {} {Missing second trail byte} + utf-8 E181 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 E181 strict {} 0 {} {Missing second trail byte} + utf-8 E1BF tcl8 \u00E1\u00BF -1 {} {Missing second trail byte} + utf-8 E1BF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 E1BF strict {} 0 {} {Missing second trail byte} + utf-8 E1807F tcl8 \u00E1\u20AC\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 E1807F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 E1807F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 E1BF7F tcl8 \u00E1\u00BF\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 E1BF7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 E1BF7F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 EC tcl8 \u00EC -1 {} {Missing trail byte} + utf-8 EC replace \uFFFD -1 {} {Missing trail byte} + utf-8 EC strict {} 0 {} {Missing trail byte} + utf-8 EC7F tcl8 \u00EC\x7F -1 {} {Trail byte must be 80:BF} + utf-8 EC7F replace \uFFFD\x7F -1 {} {Trail byte must be 80:BF} + utf-8 EC7F strict {} 0 {} {Trail byte must be 80:BF} + utf-8 EC81 tcl8 \u00EC\u0081 -1 {} {Missing second trail byte} + utf-8 EC81 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 EC81 strict {} 0 {} {Missing second trail byte} + utf-8 ECBF tcl8 \u00EC\u00BF -1 {} {Missing second trail byte} + utf-8 ECBF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 ECBF strict {} 0 {} {Missing second trail byte} + utf-8 EC807F tcl8 \u00EC\u20AC\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 EC807F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 EC807F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 ECBF7F tcl8 \u00EC\u00BF\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 ECBF7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 ECBF7F strict {} 0 {} {Second trail byte must be 80:BF} + + utf-8 ED tcl8 \u00ED -1 {} {Missing trail byte} + utf-8 ED replace \uFFFD -1 {} {Missing trail byte} + utf-8 ED strict {} 0 {} {Missing trail byte} + utf-8 ED7F tcl8 \u00ED\u7F -1 {} {First trail byte must be 80:9F} + utf-8 ED7F replace \uFFFD\u7F -1 {} {First trail byte must be 80:9F} + utf-8 ED7F strict {} 0 {} {First trail byte must be 80:9F} + utf-8 EDA0 tcl8 \u00ED\u00A0 -1 {} {First trail byte must be 80:9F} + utf-8 EDA0 replace \uFFFD\uFFFD -1 {} {First trail byte must be 80:9F} + utf-8 EDA0 strict {} 0 {} {First trail byte must be 80:9F} + utf-8 ED81 tcl8 \u00ED\u0081 -1 {} {Missing second trail byte} + utf-8 ED81 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 ED81 strict {} 0 {} {Missing second trail byte} + utf-8 EDBF tcl8 \u00ED\u00BF -1 {} {Missing second trail byte} + utf-8 EDBF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 EDBF strict {} 0 {} {Missing second trail byte} + utf-8 ED807F tcl8 \u00ED\u20AC\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 ED807F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 ED807F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 ED9F7F tcl8 \u00ED\u0178\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 ED9F7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 ED9F7F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 EDA080 tcl8 \uD800 -1 {} {High surrogate} + utf-8 EDA080 replace \uFFFD -1 {} {High surrogate} + utf-8 EDA080 strict {} 0 {} {High surrogate} + utf-8 EDAFBF tcl8 \uDBFF -1 {} {High surrogate} + utf-8 EDAFBF replace \uFFFD -1 {} {High surrogate} + utf-8 EDAFBF strict {} 0 {} {High surrogate} + utf-8 EDB080 tcl8 \uDC00 -1 {} {Low surrogate} + utf-8 EDB080 replace \uFFFD -1 {} {Low surrogate} + utf-8 EDB080 strict {} 0 {} {Low surrogate} + utf-8 EDBFBF tcl8 \uDFFF -1 {} {Low surrogate} + utf-8 EDBFBF replace \uFFFD -1 {} {Low surrogate} + utf-8 EDBFBF strict {} 0 {} {Low surrogate} + utf-8 EDA080EDB080 tcl8 \U00010000 -1 {} {High low surrogate pair} + utf-8 EDA080EDB080 replace \uFFFD\uFFFD -1 {} {High low surrogate pair} + utf-8 EDA080EDB080 strict {} 0 {} {High low surrogate pair} + utf-8 EDAFBFEDBFBF tcl8 \U0010FFFF -1 {} {High low surrogate pair} + utf-8 EDAFBFEDBFBF replace \uFFFD\uFFFD -1 {} {High low surrogate pair} + utf-8 EDAFBFEDBFBF strict {} 0 {} {High low surrogate pair} + + utf-8 EE tcl8 \u00EE -1 {} {Missing trail byte} + utf-8 EE replace \uFFFD -1 {} {Missing trail byte} + utf-8 EE strict {} 0 {} {Missing trail byte} + utf-8 EE7F tcl8 \u00EE\u7F -1 {} {First trail byte must be 80:BF} + utf-8 EE7F replace \uFFFD\u7F -1 {} {First trail byte must be 80:BF} + utf-8 EE7F strict {} 0 {} {First trail byte must be 80:BF} + utf-8 EED0 tcl8 \u00EE\u00D0 -1 {} {First trail byte must be 80:BF} + utf-8 EED0 replace \uFFFD\uFFFD -1 {} {First trail byte must be 80:BF} + utf-8 EED0 strict {} 0 {} {First trail byte must be 80:BF} + utf-8 EE81 tcl8 \u00EE\u0081 -1 {} {Missing second trail byte} + utf-8 EE81 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 EE81 strict {} 0 {} {Missing second trail byte} + utf-8 EEBF tcl8 \u00EE\u00BF -1 {} {Missing second trail byte} + utf-8 EEBF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 EEBF strict {} 0 {} {Missing second trail byte} + utf-8 EE807F tcl8 \u00EE\u20AC\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 EE807F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 EE807F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 EEBF7F tcl8 \u00EE\u00BF\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 EEBF7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 EEBF7F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 EF tcl8 \u00EF -1 {} {Missing trail byte} + utf-8 EF replace \uFFFD -1 {} {Missing trail byte} + utf-8 EF strict {} 0 {} {Missing trail byte} + utf-8 EF7F tcl8 \u00EF\u7F -1 {} {First trail byte must be 80:BF} + utf-8 EF7F replace \uFFFD\u7F -1 {} {First trail byte must be 80:BF} + utf-8 EF7F strict {} 0 {} {First trail byte must be 80:BF} + utf-8 EFD0 tcl8 \u00EF\u00D0 -1 {} {First trail byte must be 80:BF} + utf-8 EFD0 replace \uFFFD\uFFFD -1 {} {First trail byte must be 80:BF} + utf-8 EFD0 strict {} 0 {} {First trail byte must be 80:BF} + utf-8 EF81 tcl8 \u00EF\u0081 -1 {} {Missing second trail byte} + utf-8 EF81 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 EF81 strict {} 0 {} {Missing second trail byte} + utf-8 EFBF tcl8 \u00EF\u00BF -1 {} {Missing second trail byte} + utf-8 EFBF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 EFBF strict {} 0 {} {Missing second trail byte} + utf-8 EF807F tcl8 \u00EF\u20AC\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 EF807F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 EF807F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 EFBF7F tcl8 \u00EF\u00BF\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 EFBF7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 EFBF7F strict {} 0 {} {Second trail byte must be 80:BF} + + utf-8 F0 tcl8 \u00F0 -1 {} {Missing trail byte} + utf-8 F0 replace \uFFFD -1 {} {Missing trail byte} + utf-8 F0 strict {} 0 {} {Missing trail byte} + utf-8 F080 tcl8 \u00F0\u20AC -1 {} {First trail byte must be 90:BF} + utf-8 F080 replace \uFFFD -1 {knownW3C} {First trail byte must be 90:BF} + utf-8 F080 strict {} 0 {} {First trail byte must be 90:BF} + utf-8 F08F tcl8 \u00F0\u8F -1 {} {First trail byte must be 90:BF} + utf-8 F08F replace \uFFFD -1 {knownW3C} {First trail byte must be 90:BF} + utf-8 F08F strict {} 0 {} {First trail byte must be 90:BF} + utf-8 F0D0 tcl8 \u00F0\u00D0 -1 {} {First trail byte must be 90:BF} + utf-8 F0D0 replace \uFFFD\uFFFD -1 {} {First trail byte must be 90:BF} + utf-8 F0D0 strict {} 0 {} {First trail byte must be 90:BF} + utf-8 F090 tcl8 \u00F0\u0090 -1 {} {Missing second trail byte} + utf-8 F090 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 F090 strict {} 0 {} {Missing second trail byte} + utf-8 F0BF tcl8 \u00F0\u00BF -1 {} {Missing second trail byte} + utf-8 F0BF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 F0BF strict {} 0 {} {Missing second trail byte} + utf-8 F0907F tcl8 \u00F0\u0090\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 F0907F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 F0907F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 F0BF7F tcl8 \u00F0\u00BF\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 F0BF7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 F0BF7F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 F090BF tcl8 \u00F0\u0090\u00BF -1 {} {Missing third trail byte} + utf-8 F090BF replace \uFFFD -1 {knownW3C} {Missing third trail byte} + utf-8 F090BF strict {} 0 {} {Missing third trail byte} + utf-8 F0BF81 tcl8 \u00F0\u00BF\u0081 -1 {} {Missing third trail byte} + utf-8 F0BF81 replace \uFFFD -1 {knownW3C} {Missing third trail byte} + utf-8 F0BF81 strict {} 0 {} {Missing third trail byte} + utf-8 F0BF807F tcl8 \u00F0\u00BF\u20AC\x7F -1 {} {Third trail byte must be 80:BF} + utf-8 F0BF817F replace \uFFFD\x7F -1 {knownW3C} {Third trail byte must be 80:BF} + utf-8 F0BF817F strict {} 0 {} {Third trail byte must be 80:BF} + utf-8 F090BFD0 tcl8 \u00F0\u0090\u00BF\u00D0 -1 {} {Third trail byte must be 80:BF} + utf-8 F090BFD0 replace \uFFFD -1 {knownW3C} {Third trail byte must be 80:BF} + utf-8 F090BFD0 strict {} 0 {} {Third trail byte must be 80:BF} + + utf-8 F1 tcl8 \u00F1 -1 {} {Missing trail byte} + utf-8 F1 replace \uFFFD -1 {} {Missing trail byte} + utf-8 F1 strict {} 0 {} {Missing trail byte} + utf-8 F17F tcl8 \u00F1\u7F -1 {} {First trail byte must be 80:BF} + utf-8 F17F replace \uFFFD -1 {knownW3C} {First trail byte must be 80:BF} + utf-8 F17F strict {} 0 {} {First trail byte must be 80:BF} + utf-8 F1D0 tcl8 \u00F1\u00D0 -1 {} {First trail byte must be 80:BF} + utf-8 F1D0 replace \uFFFD\uFFFD -1 {} {First trail byte must be 80:BF} + utf-8 F1D0 strict {} 0 {} {First trail byte must be 80:BF} + utf-8 F180 tcl8 \u00F1\u20AC -1 {} {Missing second trail byte} + utf-8 F180 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 F180 strict {} 0 {} {Missing second trail byte} + utf-8 F1BF tcl8 \u00F1\u00BF -1 {} {Missing second trail byte} + utf-8 F1BF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 F1BF strict {} 0 {} {Missing second trail byte} + utf-8 F1807F tcl8 \u00F1\u20AC\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 F1807F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 F1807F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 F1BF7F tcl8 \u00F1\u00BF\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 F1BF7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 F1BF7F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 F180BF tcl8 \u00F1\u20AC\u00BF -1 {} {Missing third trail byte} + utf-8 F180BF replace \uFFFD -1 {knownW3C} {Missing third trail byte} + utf-8 F180BF strict {} 0 {} {Missing third trail byte} + utf-8 F1BF81 tcl8 \u00F1\u00BF\u0081 -1 {} {Missing third trail byte} + utf-8 F1BF81 replace \uFFFD -1 {knownW3C} {Missing third trail byte} + utf-8 F1BF81 strict {} 0 {} {Missing third trail byte} + utf-8 F1BF807F tcl8 \u00F1\u00BF\u20AC\x7F -1 {} {Third trail byte must be 80:BF} + utf-8 F1BF817F replace \uFFFD\x7F -1 {knownW3C} {Third trail byte must be 80:BF} + utf-8 F1BF817F strict {} 0 {} {Third trail byte must be 80:BF} + utf-8 F180BFD0 tcl8 \u00F1\u20AC\u00BF\u00D0 -1 {} {Third trail byte must be 80:BF} + utf-8 F180BFD0 replace \uFFFD -1 {knownW3C} {Third trail byte must be 80:BF} + utf-8 F180BFD0 strict {} 0 {} {Third trail byte must be 80:BF} + utf-8 F3 tcl8 \u00F3 -1 {} {Missing trail byte} + utf-8 F3 replace \uFFFD -1 {} {Missing trail byte} + utf-8 F3 strict {} 0 {} {Missing trail byte} + utf-8 F37F tcl8 \u00F3\x7F -1 {} {First trail byte must be 80:BF} + utf-8 F37F replace \uFFFD -1 {knownW3C} {First trail byte must be 80:BF} + utf-8 F37F strict {} 0 {} {First trail byte must be 80:BF} + utf-8 F3D0 tcl8 \u00F3\u00D0 -1 {} {First trail byte must be 80:BF} + utf-8 F3D0 replace \uFFFD\uFFFD -1 {} {First trail byte must be 80:BF} + utf-8 F3D0 strict {} 0 {} {First trail byte must be 80:BF} + utf-8 F380 tcl8 \u00F3\u20AC -1 {} {Missing second trail byte} + utf-8 F380 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 F380 strict {} 0 {} {Missing second trail byte} + utf-8 F3BF tcl8 \u00F3\u00BF -1 {} {Missing second trail byte} + utf-8 F3BF replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 F3BF strict {} 0 {} {Missing second trail byte} + utf-8 F3807F tcl8 \u00F3\u20AC\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 F3807F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 F3807F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 F3BF7F tcl8 \u00F3\u00BF\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 F3BF7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 F3BF7F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 F380BF tcl8 \u00F3\u20AC\u00BF -1 {} {Missing third trail byte} + utf-8 F380BF replace \uFFFD -1 {knownW3C} {Missing third trail byte} + utf-8 F380BF strict {} 0 {} {Missing third trail byte} + utf-8 F3BF81 tcl8 \u00F3\u00BF\u0081 -1 {} {Missing third trail byte} + utf-8 F3BF81 replace \uFFFD -1 {knownW3C} {Missing third trail byte} + utf-8 F3BF81 strict {} 0 {} {Missing third trail byte} + utf-8 F3BF807F tcl8 \u00F3\u00BF\u20AC\x7F -1 {} {Third trail byte must be 80:BF} + utf-8 F3BF817F replace \uFFFD\x7F -1 {knownW3C} {Third trail byte must be 80:BF} + utf-8 F3BF817F strict {} 0 {} {Third trail byte must be 80:BF} + utf-8 F380BFD0 tcl8 \u00F3\u20AC\u00BF\u00D0 -1 {} {Third trail byte must be 80:BF} + utf-8 F380BFD0 replace \uFFFD -1 {knownW3C} {Third trail byte must be 80:BF} + utf-8 F380BFD0 strict {} 0 {} {Third trail byte must be 80:BF} + + utf-8 F4 tcl8 \u00F4 -1 {} {Missing trail byte} + utf-8 F4 replace \uFFFD -1 {} {Missing trail byte} + utf-8 F4 strict {} 0 {} {Missing trail byte} + utf-8 F47F tcl8 \u00F4\u7F -1 {} {First trail byte must be 80:8F} + utf-8 F47F replace \uFFFD\u7F -1 {knownW3C} {First trail byte must be 80:8F} + utf-8 F47F strict {} 0 {} {First trail byte must be 80:8F} + utf-8 F490 tcl8 \u00F4\u0090 -1 {} {First trail byte must be 80:8F} + utf-8 F490 replace \uFFFD\uFFFD -1 {} {First trail byte must be 80:8F} + utf-8 F490 strict {} 0 {} {First trail byte must be 80:8F} + utf-8 F480 tcl8 \u00F4\u20AC -1 {} {Missing second trail byte} + utf-8 F480 replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 F480 strict {} 0 {} {Missing second trail byte} + utf-8 F48F tcl8 \u00F4\u008F -1 {} {Missing second trail byte} + utf-8 F48F replace \uFFFD -1 {knownW3C} {Missing second trail byte} + utf-8 F48F strict {} 0 {} {Missing second trail byte} + utf-8 F4807F tcl8 \u00F4\u20AC\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 F4807F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 F4807F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 F48F7F tcl8 \u00F4\u008F\x7F -1 {} {Second trail byte must be 80:BF} + utf-8 F48F7F replace \uFFFD\u7F -1 {knownW3C} {Second trail byte must be 80:BF} + utf-8 F48F7F strict {} 0 {} {Second trail byte must be 80:BF} + utf-8 F48081 tcl8 \u00F4\u20AC\u0081 -1 {} {Missing third trail byte} + utf-8 F48081 replace \uFFFD -1 {knownW3C} {Missing third trail byte} + utf-8 F48081 strict {} 0 {} {Missing third trail byte} + utf-8 F48F81 tcl8 \u00F4\u008F\u0081 -1 {} {Missing third trail byte} + utf-8 F48F81 replace \uFFFD -1 {knownW3C} {Missing third trail byte} + utf-8 F48F81 strict {} 0 {} {Missing third trail byte} + utf-8 F481817F tcl8 \u00F4\u0081\u0081\x7F -1 {} {Third trail byte must be 80:BF} + utf-8 F480817F replace \uFFFD\x7F -1 {knownW3C} {Third trail byte must be 80:BF} + utf-8 F480817F strict {} 0 {} {Third trail byte must be 80:BF} + utf-8 F48FBFD0 tcl8 \u00F4\u008F\u00BF\u00D0 -1 {} {Third trail byte must be 80:BF} + utf-8 F48FBFD0 replace \uFFFD -1 {knownW3C} {Third trail byte must be 80:BF} + utf-8 F48FBFD0 strict {} 0 {} {Third trail byte must be 80:BF} + + utf-8 F5 tcl8 \u00F5 -1 {} {F5:FF are invalid everywhere} + utf-8 F5 replace \uFFFD -1 {} {F5:FF are invalid everywhere} + utf-8 F5 strict {} 0 {} {F5:FF are invalid everywhere} + utf-8 FF tcl8 \u00FF -1 {} {F5:FF are invalid everywhere} + utf-8 FF replace \uFFFD -1 {} {F5:FF are invalid everywhere} + utf-8 FF strict {} 0 {} {F5:FF are invalid everywhere} + + utf-8 C0AFE080BFF0818130 replace \uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\x30 -1 {} {Unicode Table 3-8} + utf-8 EDA080EDBFBFEDAF30 replace \uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\x30 -1 {knownW3C} {Unicode Table 3-9} + utf-8 F4919293FF4180BF30 replace \uFFFD\uFFFD\uFFFD\uFFFD\uFFFD\u0041\uFFFD\uFFFD\x30 -1 {} {Unicode Table 3-10} + utf-8 E180E2F09192F1BF30 replace \uFFFD\uFFFD\uFFFD\uFFFD\x30 -1 {knownW3C} {Unicode Table 3.11} +} + +# utf16-le and utf16-be test cases. Note utf16 cases are automatically generated +# based on these depending on platform endianness. Note truncated tests can only +# happen when the sequence is at the end (including by itself) Thus {solo tail} +# in some cases. +lappend encInvalidBytes {*}{ + utf-16le 41 tcl8 \uFFFD -1 {solo tail} {Truncated} + utf-16le 41 replace \uFFFD -1 {solo tail} {Truncated} + utf-16le 41 strict {} 0 {solo tail} {Truncated} + utf-16le 00D8 tcl8 \uD800 -1 {} {Missing low surrogate} + utf-16le 00D8 replace \uFFFD -1 {knownBug} {Missing low surrogate} + utf-16le 00D8 strict {} 0 {knownBug} {Missing low surrogate} + utf-16le 00DC tcl8 \uDC00 -1 {} {Missing high surrogate} + utf-16le 00DC replace \uFFFD -1 {knownBug} {Missing high surrogate} + utf-16le 00DC strict {} 0 {knownBug} {Missing high surrogate} + + utf-16be 41 tcl8 \uFFFD -1 {solo tail} {Truncated} + utf-16be 41 replace \uFFFD -1 {solo tail} {Truncated} + utf-16be 41 strict {} 0 {solo tail} {Truncated} + utf-16be D800 tcl8 \uD800 -1 {} {Missing low surrogate} + utf-16be D800 replace \uFFFD -1 {knownBug} {Missing low surrogate} + utf-16be D800 strict {} 0 {knownBug} {Missing low surrogate} + utf-16be DC00 tcl8 \uDC00 -1 {} {Missing high surrogate} + utf-16be DC00 replace \uFFFD -1 {knownBug} {Missing high surrogate} + utf-16be DC00 strict {} 0 {knownBug} {Missing high surrogate} +} + +# utf32-le and utf32-be test cases. Note utf32 cases are automatically generated +# based on these depending on platform endianness. Note truncated tests can only +# happen when the sequence is at the end (including by itself) Thus {solo tail} +# in some cases. +lappend encInvalidBytes {*}{ + utf-32le 41 tcl8 \uFFFD -1 {solo tail} {Truncated} + utf-32le 41 replace \uFFFD -1 {solo} {Truncated} + utf-32le 41 strict {} 0 {solo tail} {Truncated} + utf-32le 4100 tcl8 \uFFFD -1 {solo tail} {Truncated} + utf-32le 4100 replace \uFFFD -1 {solo} {Truncated} + utf-32le 4100 strict {} 0 {solo tail} {Truncated} + utf-32le 410000 tcl8 \uFFFD -1 {solo tail} {Truncated} + utf-32le 410000 replace \uFFFD -1 {solo} {Truncated} + utf-32le 410000 strict {} 0 {solo tail} {Truncated} + utf-32le 00D80000 tcl8 \uD800 -1 {} {High-surrogate} + utf-32le 00D80000 replace \uFFFD -1 {} {High-surrogate} + utf-32le 00D80000 strict {} 0 {} {High-surrogate} + utf-32le 00DC0000 tcl8 \uDC00 -1 {} {Low-surrogate} + utf-32le 00DC0000 replace \uFFFD -1 {} {Low-surrogate} + utf-32le 00DC0000 strict {} 0 {} {Low-surrogate} + utf-32le 00D8000000DC0000 tcl8 \uD800\uDC00 -1 {} {High-low-surrogate-pair} + utf-32le 00D8000000DC0000 replace \uFFFD\uFFFD -1 {} {High-low-surrogate-pair} + utf-32le 00D8000000DC0000 strict {} 0 {} {High-low-surrogate-pair} + utf-32le 00001100 tcl8 \UFFFD -1 {} {Out of range} + utf-32le 00001100 replace \UFFFD -1 {} {Out of range} + utf-32le 00001100 strict {} 0 {} {Out of range} + utf-32le FFFFFFFF tcl8 \UFFFD -1 {} {Out of range} + utf-32le FFFFFFFF replace \UFFFD -1 {} {Out of range} + utf-32le FFFFFFFF strict {} 0 {} {Out of range} + + utf-32be 41 tcl8 \uFFFD -1 {solo tail} {Truncated} + utf-32be 41 replace \uFFFD -1 {solo tail} {Truncated} + utf-32be 41 strict {} 0 {solo tail} {Truncated} + utf-32be 0041 tcl8 \uFFFD -1 {solo tail} {Truncated} + utf-32be 0041 replace \uFFFD -1 {solo} {Truncated} + utf-32be 0041 strict {} 0 {solo tail} {Truncated} + utf-32be 000041 tcl8 \uFFFD -1 {solo tail} {Truncated} + utf-32be 000041 replace \uFFFD -1 {solo} {Truncated} + utf-32be 000041 strict {} 0 {solo tail} {Truncated} + utf-32be 0000D800 tcl8 \uD800 -1 {} {High-surrogate} + utf-32be 0000D800 replace \uFFFD -1 {} {High-surrogate} + utf-32be 0000D800 strict {} 0 {} {High-surrogate} + utf-32be 0000DC00 tcl8 \uDC00 -1 {} {Low-surrogate} + utf-32be 0000DC00 replace \uFFFD -1 {} {Low-surrogate} + utf-32be 0000DC00 strict {} 0 {} {Low-surrogate} + utf-32be 0000D8000000DC00 tcl8 \uD800\uDC00 -1 {} {High-low-surrogate-pair} + utf-32be 0000D8000000DC00 replace \uFFFD\uFFFD -1 {} {High-low-surrogate-pair} + utf-32be 0000D8000000DC00 strict {} 0 {} {High-low-surrogate-pair} + utf-32be 00110000 tcl8 \UFFFD -1 {} {Out of range} + utf-32be 00110000 replace \UFFFD -1 {} {Out of range} + utf-32be 00110000 strict {} 0 {} {Out of range} + utf-32be FFFFFFFF tcl8 \UFFFD -1 {} {Out of range} + utf-32be FFFFFFFF replace \UFFFD -1 {} {Out of range} + utf-32be FFFFFFFF strict {} 0 {} {Out of range} +} + +# Strings that cannot be encoded for specific encoding / profiles +# <ENCODING STRING PROFILE EXPECTEDRESULT EXPECTEDFAILINDEX CTRL COMMENT> +# <ENCODING,STRING,PROFILE> should be unique for test ids to be unique. +# See earlier comments about CTRL field. +# +# Note utf-16, utf-32 missing because they are automatically +# generated based on le/be versions. +# TODO - out of range code point (note cannot be generated by \U notation) +lappend encUnencodableStrings {*}{ + ascii \u00e0 tcl8 3f -1 {} {unencodable} + ascii \u00e0 strict {} 0 {} {unencodable} + + iso8859-1 \u0141 tcl8 3f -1 {} unencodable + iso8859-1 \u0141 strict {} 0 {} unencodable + + utf-8 \uD800 tcl8 eda080 -1 {} High-surrogate + utf-8 \uD800 strict {} 0 {} High-surrogate + utf-8 \uDC00 tcl8 edb080 -1 {} High-surrogate + utf-8 \uDC00 strict {} 0 {} High-surrogate +} + + +# The icuUcmTests.tcl is generated by the tools/ucm2tests.tcl script +# and generates test vectors for the above tables for various encodings +# based on ICU UCM files. +# TODO - commented out for now as generating a lot of mismatches. +# source [file join [file dirname [info script]] icuUcmTests.tcl] diff --git a/tests/env.test b/tests/env.test index dd88431..5317897 100644 --- a/tests/env.test +++ b/tests/env.test @@ -16,9 +16,7 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] # [exec] is required here to see the actual environment received by child # processes. @@ -106,8 +104,8 @@ variable keep { __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM CommonProgramFiles CommonProgramFiles(x86) ProgramFiles ProgramFiles(x86) CommonProgramW6432 ProgramW6432 - WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR PROCESSOR_ARCHITECTURE - USERPROFILE + PROCESSOR_ARCHITECTURE PROCESSOR_ARCHITEW6432 USERPROFILE + WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR } variable printenvScript [makeFile [string map [list @keep@ [list $keep]] { @@ -223,9 +221,9 @@ NAME2=more XYZZY=garbage} test env-2.5 {different encoding (wide chars)} -constraints {win exec} -setup { - # be sure set of (unicode) environment occurs if single-byte encoding is used: + # be sure set of (Unicode) environment occurs if single-byte encoding is used: encodingswitch cp1252 - # german (cp1252) and russian (cp1251) characters together encoded as utf-8: + # German (cp1252) and Russian (cp1251) characters together encoded as utf-8: set val 2d2dc3a4c3b6c3bcc39f2dd182d0b5d181d1822d2d set env(XYZZY) [encoding convertfrom utf-8 [binary decode hex $val]] # now switch to utf-8 (to see correct values from test): @@ -305,7 +303,7 @@ test env-5.1 { corner cases - remove one elem at a time } -setup setup1 -body { # When no environment variables exist, the env var will contain no - # entries. The "array names" call synchs up the C-level environ array with + # entries. The "array names" call syncs up the C-level environ array with # the Tcl level env array. Make sure an empty Tcl array is created. foreach e [array names env] { unset env($e) @@ -349,7 +347,7 @@ test env-5.4 {corner cases - unset the env array} -setup { setup1 interp create i } -body { - # The info exists command should be in synch with the env array. + # The info exists command should be in sync with the env array. # Know Bug: 1737 i eval {set env(THIS_SHOULD_EXIST) a} set result [info exists env(THIS_SHOULD_EXIST)] diff --git a/tests/error.test b/tests/error.test index 4ce7709..5bed039 100644 --- a/tests/error.test +++ b/tests/error.test @@ -924,7 +924,7 @@ test error-18.12 {variable assignment unaffected by exception in finally} { list $em [dict get $opts -errorcode] } {bar FOO} -# try tests - fallthough body cases +# try tests - fall-through body cases test error-19.1 {try with fallthrough body #1} { set RES {} diff --git a/tests/eval.test b/tests/eval.test index 5ffe309..9b8eccd 100644 --- a/tests/eval.test +++ b/tests/eval.test @@ -64,7 +64,7 @@ test eval-3.2 {concatenating eval and pure lists} { } {1 2 3 4 5} test eval-3.3 {eval and canonical lists} { set cmd [list list 1 2 3 4 5] - # Force existance of utf-8 rep + # Force existence of utf-8 rep set dummy($cmd) $cmd unset dummy eval $cmd @@ -72,7 +72,7 @@ test eval-3.3 {eval and canonical lists} { test eval-3.4 {concatenating eval and canonical lists} { set cmd [list list 1] set cmd2 [list 2 3 4 5] - # Force existance of utf-8 rep + # Force existence of utf-8 rep set dummy($cmd) $cmd set dummy($cmd2) $cmd2 unset dummy diff --git a/tests/event.test b/tests/event.test index 16cbc24..d62d08e 100644 --- a/tests/event.test +++ b/tests/event.test @@ -427,7 +427,7 @@ foo # someday : add a test checking that when there is no bgerror, an error msg # goes to stderr ideally one would use sub interp and transfer a fake stderr -# to it, unfortunatly the current interp tcl API does not allow that. The +# to it, unfortunately the current interp tcl API does not allow that. The # other option would be to use fork a test but it then becomes more a # file/exec test than a bgerror test. diff --git a/tests/exec.test b/tests/exec.test index 6e4718a..4058ae9 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -18,20 +18,14 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } +source [file join [file dirname [info script]] tcltests.tcl] -loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests - -# All tests require the "exec" command. -# Skip them if exec is not defined. -testConstraint exec [llength [info commands exec]] # Some skips when running in a macOS CI environment testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}] unset -nocomplain path -# Utilities that are like bourne shell stalwarts, but cross-platform. +# Utilities that are like Bourne shell stalwarts, but cross-platform. set path(echo) [makeFile { puts -nonewline [lindex $argv 0] foreach str [lrange $argv 1 end] { diff --git a/tests/execute.test b/tests/execute.test index d86ad0e..8702de6 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -179,7 +179,7 @@ test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 + $x} @@ -204,7 +204,7 @@ test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_SUB is partially tested: test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} { @@ -231,7 +231,7 @@ test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 - $x} @@ -256,7 +256,7 @@ test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_MULT is partially tested: test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} { @@ -283,7 +283,7 @@ test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} { set x [testintobj set 1 1] expr {1 * $x} @@ -308,7 +308,7 @@ test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} # INST_DIV is partially tested: test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} { @@ -335,7 +335,7 @@ test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} { set x [testintobj set 1 1] expr {2 / $x} @@ -360,7 +360,7 @@ test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} # INST_UPLUS is partially tested: test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} { @@ -387,7 +387,7 @@ test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_UMINUS is partially tested: test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} { @@ -414,7 +414,7 @@ test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testob test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_LNOT is partially tested: test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { @@ -462,7 +462,7 @@ test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "foo" as operand of "!"}} # INST_BITNOT not tested # INST_CALL_BUILTIN_FUNC1 not tested diff --git a/tests/expr-old.test b/tests/expr-old.test index 676443a..2401bd4 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -194,34 +194,34 @@ test expr-old-2.38 {floating-point operators} { test expr-old-3.1 {illegal floating-point operations} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-old-3.2 {illegal floating-point operations} { list [catch {expr 27%4.0} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "4.0" as operand of "%"}} test expr-old-3.3 {illegal floating-point operations} { list [catch {expr 27.0%4} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "27.0" as operand of "%"}} test expr-old-3.4 {illegal floating-point operations} { list [catch {expr 1.0<<3} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.5 {illegal floating-point operations} { list [catch {expr 3<<1.0} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.6 {illegal floating-point operations} { list [catch {expr 24.0>>3} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-old-3.7 {illegal floating-point operations} { list [catch {expr 24>>3.0} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "3.0" as operand of ">>"}} test expr-old-3.8 {illegal floating-point operations} { list [catch {expr 24&3.0} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "3.0" as operand of "&"}} test expr-old-3.9 {illegal floating-point operations} { list [catch {expr 24.0|3} msg] $msg -} {1 {can't use floating-point value as operand of "|"}} +} {1 {can't use floating-point value "24.0" as operand of "|"}} test expr-old-3.10 {illegal floating-point operations} { list [catch {expr 24.0^3} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} # Check the string operators individually. @@ -262,46 +262,46 @@ test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.2 {illegal string operations} { list [catch {expr {+"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.3 {illegal string operations} { list [catch {expr {~"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "a" as operand of "~"}} test expr-old-5.4 {illegal string operations} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-old-5.5 {illegal string operations} { list [catch {expr {"a"*"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "a" as operand of "*"}} test expr-old-5.6 {illegal string operations} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-5.7 {illegal string operations} { list [catch {expr {"a"%"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "%"}} +} {1 {can't use non-numeric string "a" as operand of "%"}} test expr-old-5.8 {illegal string operations} { list [catch {expr {"a"+"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.9 {illegal string operations} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.10 {illegal string operations} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-old-5.11 {illegal string operations} { list [catch {expr {"a">>"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of ">>"}} +} {1 {can't use non-numeric string "a" as operand of ">>"}} test expr-old-5.12 {illegal string operations} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-old-5.13 {illegal string operations} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-old-5.14 {illegal string operations} { list [catch {expr {"a"|"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "|"}} +} {1 {can't use non-numeric string "a" as operand of "|"}} test expr-old-5.15 {illegal string operations} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -490,7 +490,7 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0 test expr-old-26.1 {error conditions} { list [catch {expr 2+"a"} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * @@ -504,10 +504,10 @@ test expr-old-26.4 {error conditions} { set a xx test expr-old-26.5 {error conditions} { list [catch {expr {2+$a}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.6 {error conditions} { list [catch {expr {2+[set a]}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.7 {error conditions} -body { expr {2+(4} } -returnCodes error -match glob -result * @@ -531,7 +531,7 @@ test expr-old-26.12 {error conditions} -body { } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-26.14 {error conditions} -body { expr 2:3 } -returnCodes error -match glob -result * @@ -943,13 +943,14 @@ test expr-old-34.15 {errors in math functions} { test expr-old-34.16 {errors in math functions} { expr round(-1.0e30) } -1000000000000000019884624838656 + test expr-old-36.1 {ExprLooksLikeInt procedure} -body { expr 0o289 } -returnCodes error -match glob -result {*invalid octal number*} test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0o289 list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use invalid octal number "0o289" as operand of "+"}} test expr-old-36.3 {ExprLooksLikeInt procedure} { list [catch {expr 0289.1} msg] $msg } {0 289.1} @@ -989,11 +990,11 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} { test expr-old-36.12 {ExprLooksLikeInt procedure} { set x "10;" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "10;" as operand of "+"}} test expr-old-36.13 {ExprLooksLikeInt procedure} { set x " +" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string " +" as operand of "+"}} test expr-old-36.14 {ExprLooksLikeInt procedure} { set x "123456789012345678901234567890 " expr {$x+1} @@ -1001,7 +1002,7 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} { test expr-old-36.15 {ExprLooksLikeInt procedure} { set x "0o99 " list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use invalid octal number "0o99 " as operand of "+"}} test expr-old-36.16 {ExprLooksLikeInt procedure} { set x " 0xffffffffffffffffffffffffffffffffffffff " expr {$x+1} diff --git a/tests/expr.test b/tests/expr.test index 32706d9..985bce1 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -138,9 +138,9 @@ proc do_twelve_days {} { catch {unset a b i x} -test expr-1.1 {TclCompileExprCmd: no expression} { - list [catch {expr } msg] $msg -} {1 {wrong # args: should be "expr arg ?arg ...?"}} +test expr-1.1 {TclCompileExprCmd: no expression} -body { + expr +} -returnCodes error -result {wrong # args: should be "expr arg ?arg ...?"} test expr-1.2 {TclCompileExprCmd: one expression word} { expr -25 } -25 @@ -187,12 +187,12 @@ test expr-1.13 {TclCompileExprCmd: second level of substitutions in expr not in } foo test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} { set a xxx - set x 2; set b {$x}; set a [expr $b == 2] + set x 2; set b {$x}; set a [expr $b==2] set a } 1 test expr-1.15 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} { set a xxx - set x 2; set b {$x}; set a [expr $b eq 2] + set x 2; set b {$x}; set a [expr "$b eq 2"] set a } 1 @@ -252,7 +252,7 @@ test expr-4.9 {CompileLorExpr: long lor arm} { } 1 test expr-4.10 {CompileLorExpr: error compiling ! operand} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-4.11 {CompileLorExpr: error compiling land arms} { list [catch {expr {"a"||0}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -299,10 +299,10 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -323,10 +323,10 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-7.20 {CompileBitAndExpr: error in equality expr} -body { @@ -468,10 +468,10 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test expr-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -490,10 +490,10 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test expr-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -521,10 +521,10 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { } -returnCodes error -match glob -result * test expr-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test expr-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -541,10 +541,10 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test expr-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test expr-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test expr-13.13 {CompileUnaryExpr: just primary expr} { set a 27 @@ -821,15 +821,15 @@ test expr-21.13 {non-numeric boolean literals} -body { } -returnCodes error -match glob -result * test expr-21.14 {non-numeric boolean literals} { list [catch {expr !"truef"} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.15 {non-numeric boolean variables} { set v truef list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.16 {non-numeric boolean variables} { set v "true " list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "true " as operand of "!"}} test expr-21.17 {non-numeric boolean variables} { set v "tru" list [catch {expr {!$v}} err] $err @@ -849,23 +849,23 @@ test expr-21.20 {non-numeric boolean variables} { test expr-21.21 {non-numeric boolean variables} { set v "o" list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "o" as operand of "!"}} test expr-21.22 {non-numeric boolean variables} { set v "" list [catch {expr {!$v}} err] $err -} {1 {can't use empty string as operand of "!"}} +} {1 {can't use empty string "" as operand of "!"}} # Test for non-numeric float handling. test expr-22.1 {non-numeric floats} { list [catch {expr {NaN + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.2 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {Inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.3 {non-numeric floats} { set nan NaN list [catch {expr {$nan + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.4 {non-numeric floats} !ieeeFloatingPoint { set inf Inf list [catch {expr {$inf + 1}} msg] $msg @@ -878,7 +878,7 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint { } {1 {floating-point value too large to represent}} test expr-22.7 {non-numeric floats} { list [catch {expr {1 / NaN}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "/"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}} test expr-22.8 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {1 / Inf}} msg] $msg } {1 {can't use infinite floating-point value as operand of "/"}} @@ -914,10 +914,10 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body { } -returnCodes error -match glob -result * test expr-23.9 {CompileExponentialExpr: runtime error} { list [catch {expr {24.0**"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "xx" as operand of "**"}} test expr-23.10 {CompileExponentialExpr: runtime error} { list [catch {expr {"a"**2}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "a" as operand of "**"}} test expr-23.11 {CompileExponentialExpr: runtime error} { list [catch {expr {0**-1}} msg] $msg } {1 {exponentiation of zero by negative power}} @@ -7451,11 +7451,50 @@ test expr-62.10 {TIP 582: comments can go inside function calls} { expr {max# comment (1,2)} } 2 + +# Bug e3dcab1d14 +proc do-one-test-expr-63 {e p float athreshold} { + # e - power of 2 to test + # p - tcl_precision to test with + # float - floating point value 2**-$p + # athreshold - tolerable absolute error (1/2 decimal digit in + # least significant place plus 1/2 least significant bit) + set trouble {} + set ::tcl_precision $p + set xfmt x[expr $float] + set ::tcl_precision 0 + set fmt [string range $xfmt 1 end] + set aerror [expr {abs($fmt - $float)}] + if {$aerror > $athreshold} { + return "Result $fmt is more than $athreshold away from $float" + } else { + return {} + } +} + +proc run-test-expr-63 {} { + for {set e 0} {$e <= 1023} {incr e} { + set pt [expr {floor($e*log(2)/log(10))}] + for {set p 6} {$p <= 17} {incr p} { + set athreshold [expr {0.5*10.0**-($pt+$p) + 2.0**-($e+53)}] + set numer [expr {5**$e}] + set xfloat x[expr {2.**-$e}] + set float [string range $xfloat 1 end] + test expr-63.$p.$e "convert 2**-$e to decimal at precision $p" { + do-one-test-expr-63 $e $p $float $athreshold + } {} + } + } + rename do-one-test-expr-63 {} + rename run-test-expr-63 {} +} +run-test-expr-63 # cleanup unset -nocomplain a unset -nocomplain min unset -nocomplain max + ::tcltest::cleanupTests return diff --git a/tests/fCmd.test b/tests/fCmd.test index 73118f4..2469762 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -27,7 +27,7 @@ testConstraint winLessThan10 0 testConstraint notNetworkFilesystem 0 testConstraint reg 0 if {[testConstraint win]} { - catch { + if {[catch { # Is the registry extension already static to this shell? try { load {} Registry @@ -38,10 +38,16 @@ if {[testConstraint win]} { load $::reglib Registry } testConstraint reg 1 + } regError]} { + catch {package require registry; testConstraint reg 1} } } + testConstraint notInCIenv [expr {![info exists ::env(CI)] || !$::env(CI)}] +# File permissions broken on wsl without some "exotic" wsl configuration +testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] + set tmpspace /tmp;# default value # Find a group that exists on this Unix system, or else skip tests that # require Unix groups. @@ -81,7 +87,7 @@ testConstraint notFileSharing 1 testConstraint linkFile 1 testConstraint linkDirectory 1 -# Several tests require need to match results against the unix username +# Several tests require need to match results against the Unix username set user {} if {[testConstraint unix]} { catch { @@ -97,6 +103,45 @@ if {[testConstraint unix]} { } } +# Try getting a lower case glob pattern that will match the home directory of +# a given user to test ~user and [file tildeexpand ~user]. Note this may not +# be the same as ~ even when "user" is current user. For example, on Unix +# platforms ~ will return HOME envvar, but ~user will lookup password file +# bypassing HOME. If home directory not found, returns *$user* so caller can +# succeed by using glob matching under the hope that the path contains +# the user name. +proc gethomedirglob {user} { + if {[testConstraint unix]} { + if {![catch { + exec {*}[auto_execok sh] -c "echo ~$user" + } home]} { + set home [string trim $home] + if {$home ne ""} { + # Expect exact match (except case), no glob * added + return [string tolower $home] + } + } + } elseif {[testConstraint reg]} { + # Windows with registry extension loaded + if {![catch { + set sid [exec {*}[auto_execok powershell] -Command "(Get-LocalUser -Name '$user')\[0\].sid.Value"] + set sid [string trim $sid] + # Get path from the Windows registry + set home [registry get "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList\\$sid" ProfileImagePath] + set home [string trim [string tolower $home]] + } result]} { + if {$home ne ""} { + # file join for \ -> / + return [file join [string tolower $home]] + } + } + } + + # Caller will need to use glob matching and hope user + # name is in the home directory path + return *[string tolower $user]* +} + proc createfile {file {string a}} { set f [open $file w] puts -nonewline $f $string @@ -276,7 +321,7 @@ test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup { } -constraints {notRoot unixOrWin} -returnCodes error -body { file mkdir td1 file rename / td1 -} -result {error renaming "/" to "td1": file already exists} +} -result {error renaming "/" to "td1": file exists} test fCmd-3.16 {FileCopyRename: break on first error} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { @@ -287,7 +332,7 @@ test fCmd-3.16 {FileCopyRename: break on first error} -setup { file mkdir td1 createfile [file join td1 tf3] file rename tf1 tf2 tf3 tf4 td1 -} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}] +} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file exists}] test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup { cleanup @@ -343,7 +388,7 @@ test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup { } -constraints {notRoot} -returnCodes error -body { createfile tf1 file mkdir tf1 -} -result [subst {can't create directory "[file join tf1]": file already exists}] +} -result [subst {can't create directory "[file join tf1]": file exists}] test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup { cleanup } -constraints {notRoot} -body { @@ -354,7 +399,7 @@ test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup { } -result {1 1} test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup { cleanup -} -constraints {unix notRoot testchmod} -returnCodes error -body { +} -constraints {unix notRoot testchmod notWsl} -returnCodes error -body { file mkdir td1/td2/td3 testchmod 0 td1/td2 file mkdir td1/td2/td3/td4 @@ -372,7 +417,7 @@ test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup { test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup { cleanup file delete -force foo -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir foo file attr foo -perm 0o40000 file mkdir foo/tf1 @@ -384,7 +429,7 @@ test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup { } -constraints {notRoot} -body { file mkdir tf1 file exists tf1 -} -result {1} +} -result 1 test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body { file delete -xyz @@ -497,7 +542,7 @@ test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} -setup { } -result {tf2} test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup { cleanup -} -constraints {unix notRoot testchmod} -body { +} -constraints {unix notRoot testchmod notWsl} -body { file mkdir td1 testchmod 0 td1 createfile tf1 @@ -518,14 +563,14 @@ test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup { createfile tf1 createfile tf2 file rename tf1 tf2 -} -result {error renaming "tf1" to "tf2": file already exists} +} -result {error renaming "tf1" to "tf2": file exists} test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup { cleanup } -constraints {notRoot} -returnCodes error -body { createfile tf1 createfile tf2 file rename tf1 tf2 -} -result {error renaming "tf1" to "tf2": file already exists} +} -result {error renaming "tf1" to "tf2": file exists} test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup { cleanup } -constraints {notRoot} -body { @@ -616,7 +661,7 @@ test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup { } -result [file join $tmpspace tf1] test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace -} -constraints {xdev notRoot} -body { +} -constraints {xdev notRoot notWsl} -body { file mkdir td1/td2/td3 file attributes td1 -permissions 0 file rename td1 $tmpspace @@ -665,10 +710,10 @@ test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { file mkdir [file join $tmpspace td1] createfile [file join $tmpspace td1 tf1] file rename -force td1 $tmpspace -} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists} +} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file exists} test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup { cleanup $tmpspace -} -constraints {notRoot xdev} -body { +} -constraints {notRoot xdev notWsl} -body { file mkdir td1/td2/td3 file attributes td1/td2/td3 -permissions 0 file rename td1 $tmpspace @@ -685,7 +730,7 @@ test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup { } -result [file join $tmpspace td1 td2] test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup { cleanup $tmpspace -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir foo/bar file attr foo -perm 0o40555 file rename foo/bar $tmpspace @@ -742,7 +787,7 @@ test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ -constraints {unix notRoot knownBug} -body { - # Labelled knownBug because it is dangerous [Bug: 3881] + # Labeled knownBug because it is dangerous [Bug: 3881] file mkdir td1 file attr td1 -perm 0o40000 file rename ~$user td1 @@ -760,7 +805,7 @@ test fCmd-8.3 {file copy and path translation: ensure correct error} -body { test fCmd-9.1 {file rename: comprehensive: EACCES} -setup { cleanup -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir td1 file mkdir td2 file attr td2 -perm 0o40000 @@ -786,7 +831,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup { } -result {{tf3 tf4} 1 0} test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup { cleanup -} -constraints {unix notRoot testchmod notDarwin9} -body { +} -constraints {unix notRoot testchmod notDarwin9 notWsl} -body { file mkdir td1 td2 testchmod 0o555 td2 file rename td1 td3 @@ -807,7 +852,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} -setup { } -result {tf1 tf2 1 0} test fCmd-9.6 {file rename: comprehensive: dir to self} -setup { cleanup -} -constraints {unix notRoot testchmod} -body { +} -constraints {unix notRoot testchmod notWsl} -body { file mkdir td1 file mkdir td2 testchmod 0o555 td2 @@ -838,11 +883,11 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup { file rename -force tfs3 tfd3 file rename -force tfs4 tfd4 list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] -} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0} +} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file exists}} 1 1 0 0} test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup { cleanup } -constraints {notRoot testchmod notNetworkFilesystem} -body { - # Under unix, you can rename a read-only directory, but you can't move it + # Under Unix you can rename a read-only directory, but you can't move it # into another directory. file mkdir td1 file mkdir [file join td2 td1] @@ -874,7 +919,7 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup { } list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \ [file writable [file join tdd2 tds2]] $w3 $w4 -} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}] +} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file exists}} 1 1 0 0}] # Test can hit EEXIST or EBUSY, depending on underlying filesystem test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup { cleanup @@ -924,7 +969,7 @@ test fCmd-9.12 {file rename: comprehensive: target exists} -setup { [catch {file rename td1 td2} msg] $msg } -cleanup { testchmod 0o755 [file join td2 td1] -} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}] +} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file exists}}] # Test can hit EEXIST or EBUSY, depending on underlying filesystem test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup { cleanup @@ -1001,7 +1046,7 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} -setup { } -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0} test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup { cleanup -} -constraints {unix notRoot testchmod} -body { +} -constraints {unix notRoot testchmod notWsl} -body { file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 0o555 td2 @@ -1020,6 +1065,7 @@ test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup { file mkdir [file join td1 tdx] file mkdir [file join td2 tdy] testchmod 0o555 td2 + testchmod 0o555 td2/tdy; # Above line removes inherited perms. So restore. file copy td1 td3 file copy td2 td4 list [lsort [glob td*]] [glob -directory td3 t*] \ @@ -1041,17 +1087,26 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup { createfile tfd2 createfile tfd3 createfile tfd4 - testchmod 0o444 tfs3 - testchmod 0o444 tfs4 - testchmod 0o444 tfd2 - testchmod 0o444 tfd4 + if {$::tcl_platform(platform) eq "windows"} { + # On Windows testchmode will attach an ACL which file copy cannot handle + # so use good old attributes which file copy does understand + file attribute tfs3 -readonly 1 + file attribute tfs4 -readonly 1 + file attribute tfd2 -readonly 1 + file attribute tfd4 -readonly 1 + } else { + testchmod 0o444 tfs3 + testchmod 0o444 tfs4 + testchmod 0o444 tfd2 + testchmod 0o444 tfd4 + } set msg [list [catch {file copy tf1 tf2} msg] $msg] file copy -force tfs1 tfd1 file copy -force tfs2 tfd2 file copy -force tfs3 tfd3 file copy -force tfs4 tfd4 list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] -} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0} +} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file exists}} 1 1 0 0} test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup { cleanup } -constraints {notRoot testchmod} -body { @@ -1075,10 +1130,10 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup { set a4 [catch {file copy -force tds3 tdd3}] set a5 [catch {file copy -force tds4 tdd4}] list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 -} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}] +} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file exists}} 1 1 1}] test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { cleanup -} -constraints {notRoot unixOrWin testchmod} -body { +} -constraints {notRoot unixOrWin testchmod notWsl} -body { file mkdir tds1 file mkdir tds2 file mkdir [file join tdd1 tds1 xxx] @@ -1087,7 +1142,7 @@ test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup { set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg] set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg] list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2] -} -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}] +} -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file exists}} 1 0}] test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { @@ -1102,7 +1157,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup { } -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup { cleanup -} -constraints {unix notRoot testchmod} -body { +} -constraints {unix notRoot testchmod notWsl} -body { file mkdir td1 file mkdir td2 file mkdir td3 @@ -1194,7 +1249,7 @@ test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup { catch {file rename tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 -} -result {1} +} -result 1 test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup { catch {file delete -force -- tfa1 tfad} } -constraints {notRoot} -body { @@ -1239,7 +1294,7 @@ test fCmd-12.1 {renamefile: source filename translation failing} -setup { catch {file rename ~/tfa1 tfa2} } -cleanup { set ::env(HOME) $temp -} -result {1} +} -result 1 test fCmd-12.2 {renamefile: src filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { @@ -1251,7 +1306,7 @@ test fCmd-12.2 {renamefile: src filename translation failing} -setup { } -cleanup { set ::env(HOME) $temp file delete -force tfad -} -result {1} +} -result 1 test fCmd-12.3 {renamefile: stat failing on source} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { @@ -1296,10 +1351,10 @@ test fCmd-12.7 {renamefile: renaming directory into offspring} -setup { catch {file rename tfad tfad/dir} } -cleanup { file delete -force tfad -} -result {1} +} -result 1 test fCmd-12.8 {renamefile: generic error} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir tfa file mkdir tfa/dir file attributes tfa -permissions 0o555 @@ -1307,7 +1362,7 @@ test fCmd-12.8 {renamefile: generic error} -setup { } -cleanup { catch {file attributes tfa -permissions 0o777} file delete -force tfa -} -result {1} +} -result 1 test fCmd-12.9 {renamefile: moving a file across volumes} -setup { cleanup $tmpspace } -constraints {unix notRoot} -body { @@ -1369,7 +1424,7 @@ test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup { catch { file copy tfa ~/foobar } } -cleanup { set ::env(HOME) $temp -} -result {1} +} -result 1 test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup { catch {file delete -force -- tfa1 tfa2 tfa3} } -constraints {notRoot} -body { @@ -1379,7 +1434,7 @@ test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup { catch {file copy tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 -} -result {1} +} -result 1 test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup { catch {file delete -force -- tfa1 tfad} } -constraints {notRoot} -body { @@ -1425,7 +1480,7 @@ test fCmd-14.1 {copyfile: source filename translation failing} -setup { catch {file copy ~/tfa1 tfa2} } -cleanup { set ::env(HOME) $temp -} -result {1} +} -result 1 test fCmd-14.2 {copyfile: dst filename translation failing} -setup { set temp $::env(HOME) } -constraints {notRoot} -body { @@ -1486,14 +1541,14 @@ test fCmd-14.7 {copyfile: copy directory succeeding} -setup { } -result {1 1} test fCmd-14.8 {copyfile: copy directory failing} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir tfa/dir/a/b/c file attributes tfa/dir -permissions 0 catch {file copy tfa tfa2} } -cleanup { file attributes tfa/dir -permissions 0o777 file delete -force tfa tfa2 -} -result {1} +} -result 1 # # Coverage tests for TclMkdirCmd() @@ -1506,7 +1561,7 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup { catch {file mkdir ~/tfa} } -cleanup { set ::env(HOME) $temp -} -result {1} +} -result 1 # # Can Tcl_SplitPath return argc == 0? If so them we need a test for that code. # @@ -1517,7 +1572,7 @@ test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup { file isdirectory tfa } -cleanup { file delete tfa -} -result {1} +} -result 1 test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup { catch {file delete -force -- tfa1 tfa2} } -constraints {notRoot} -body { @@ -1536,7 +1591,7 @@ test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup { } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa -} -result {1} +} -result 1 test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { @@ -1544,7 +1599,7 @@ test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup file isdir tfa/a/b/c } -cleanup { file delete -force tfa -} -result {1} +} -result 1 test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { @@ -1568,7 +1623,7 @@ test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body { file isdir tfa } -constraints {notRoot} -cleanup { file delete tfa -} -result {1} +} -result 1 # Coverage tests for TclDeleteFilesCommand() test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup { @@ -1592,7 +1647,7 @@ test fCmd-16.3 {test bad option} -constraints {notRoot} -setup { catch {file delete -dog tfa} } -cleanup { file delete tfa -} -result {1} +} -result 1 test fCmd-16.4 {accept zero files (TIP 323)} -body { file delete } -result {} @@ -1607,7 +1662,7 @@ test fCmd-16.6 {delete: source filename translation failing} -setup { catch {file delete ~/tfa} } -cleanup { set ::env(HOME) $temp -} -result {1} +} -result 1 test fCmd-16.7 {remove a non-empty directory without -force} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { @@ -1616,7 +1671,7 @@ test fCmd-16.7 {remove a non-empty directory without -force} -setup { catch {file delete tfa} } -cleanup { file delete -force tfa -} -result {1} +} -result 1 test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { @@ -1625,10 +1680,10 @@ test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup { catch {file delete tfa} } -cleanup { file delete -force tfa -} -result {1} +} -result 1 test fCmd-16.9 {error while deleting file} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir tfa createfile tfa/a file attributes tfa -permissions 0o555 @@ -1641,7 +1696,7 @@ test fCmd-16.9 {error while deleting file} -setup { } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa -} -result {1} +} -result 1 test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2} } -body { @@ -1659,14 +1714,14 @@ test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup { # More coverage tests for mkpath() test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup { catch {file delete -force -- tfa1} -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir tfa1 file attributes tfa1 -permissions 0o555 catch {file mkdir tfa1/tfa2} } -cleanup { file attributes tfa1 -permissions 0o777 file delete -force tfa1 -} -result {1} +} -result 1 test fCmd-17.2 {mkdir several levels deep - relative} -setup { catch {file delete -force -- tfa} } -constraints {notRoot} -body { @@ -1683,7 +1738,7 @@ test fCmd-17.3 {mkdir several levels deep - absolute} -setup { file isdir $f } -cleanup { file delete $f [file join [pwd] tfa] -} -result {1} +} -result 1 # # Functionality tests for TclFileRenameCmd() @@ -1844,7 +1899,7 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup { checkcontent tfa1/tfa2 $s } -cleanup { file delete -force tfa1 tfalink -} -result {1} +} -result 1 test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup { catch {file delete -force -- tfa1 tfalink} } -constraints {unix notRoot} -body { @@ -1869,7 +1924,7 @@ test fCmd-19.1 {remove empty directory} -constraints {notRoot} -setup { } -result {0} test fCmd-19.2 {rmdir error besides EEXIST} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir tfa file mkdir tfa/a file attributes tfa -permissions 0o555 @@ -1877,7 +1932,7 @@ test fCmd-19.2 {rmdir error besides EEXIST} -setup { } -cleanup { file attributes tfa -permissions 0o777 file delete -force tfa -} -result {1} +} -result 1 test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup { catch {file delete -force -- tfa} } -body { @@ -1897,7 +1952,7 @@ test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup { # test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup { catch {file delete -force -- tfa} -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir tfa file mkdir tfa/a file attributes tfa/a -permissions 00000 @@ -1905,7 +1960,7 @@ test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -se } -cleanup { file attributes tfa/a -permissions 0o777 file delete -force tfa -} -result {1} +} -result 1 test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup { catch {file delete -force -- tfa} } -constraints {unix notRoot} -body { @@ -1958,7 +2013,7 @@ test fCmd-21.4 {copy : more than one source and target is not a directory} -setu catch {file copy tfa1 tfa2 tfa3} } -cleanup { file delete tfa1 tfa2 tfa3 -} -result {1} +} -result 1 test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup { catch {file delete -force -- tfa1 tfa2 tfad} } -body { @@ -2083,7 +2138,7 @@ test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup { checkcontent tfa1 $s } -cleanup { file delete tfa1 -} -result {1} +} -result 1 test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup { catch {file delete -force -- d1 tfad} } -constraints {notRoot} -body { @@ -2306,7 +2361,7 @@ test fCmd-28.6 {file link: unsupported operation} -setup { file link -hard abc.link abc.dir } -returnCodes error -cleanup { cd [workingDirectory] -} -result {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory} +} -result {could not create new link "abc.link" pointing to "abc.dir": is a directory} test fCmd-28.7 {file link: source already exists} -setup { cd [temporaryDirectory] } -constraints {linkFile} -body { @@ -2383,7 +2438,7 @@ test fCmd-28.12 {file link: cd into a link} -setup { cd $orig # Now '$up' should be either $orig or [file dirname abc.dir], depending on # whether 'cd' actually moves to the destination of a link, or simply - # treats the link as a directory. (On windows the former, on unix the + # treats the link as a directory. (On windows the former, on Unix the # latter, I believe) if { ([file normalize $up] ne [file normalize $orig]) && @@ -2543,7 +2598,7 @@ test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body expr {[info exists env(USERPROFILE)] && [file exists $env(USERPROFILE)/NTUSER.DAT] && [file readable $env(USERPROFILE)/NTUSER.DAT]} -} -result {1} +} -result 1 # At least one CI environment (GitHub Actions) is set up with the page file in # an unusual location; skip the test if that is so. test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notInCIenv} -body { @@ -2598,14 +2653,21 @@ test fCmd-31.6 {file home USER} -body { # Note - as in 8.x this form does NOT necessarily give same result as # env(HOME) even when user is current user. Assume result contains user # name, else not sure how to check - file home $::tcl_platform(user) -} -match glob -result "*$::tcl_platform(user)*" + string tolower [file home $::tcl_platform(user)] +} -match glob -result [gethomedirglob $::tcl_platform(user)] test fCmd-31.7 {file home UNKNOWNUSER} -body { file home nosuchuser } -returnCodes error -result {user "nosuchuser" doesn't exist} test fCmd-31.8 {file home extra arg} -body { file home $::tcl_platform(user) arg } -returnCodes error -result {wrong # args: should be "file home ?user?"} +test fCmd-31.9 {file home USER does not follow env(HOME)} -setup { + set ::env(HOME) [file join $::env(HOME) foo] +} -cleanup { + set ::env(HOME) [file dirname $::env(HOME)] +} -body { + string tolower [file home $::tcl_platform(user)] +} -match glob -result [gethomedirglob $::tcl_platform(user)] test fCmd-32.1 {file tildeexpand ~} -body { file tildeexpand ~ @@ -2640,8 +2702,8 @@ test fCmd-32.5 {file tildeexpand ~USER} -body { # Note - as in 8.x this form does NOT necessarily give same result as # env(HOME) even when user is current user. Assume result contains user # name, else not sure how to check - file tildeexpand ~$::tcl_platform(user) -} -match glob -result "*$::tcl_platform(user)*" + string tolower [file tildeexpand ~$::tcl_platform(user)] +} -match glob -result [gethomedirglob $::tcl_platform(user)] test fCmd-32.6 {file tildeexpand ~UNKNOWNUSER} -body { file tildeexpand ~nosuchuser } -returnCodes error -result {user "nosuchuser" doesn't exist} @@ -2655,8 +2717,8 @@ test fCmd-32.9 {file tildeexpand ~USER/bar} -body { # Note - as in 8.x this form does NOT necessarily give same result as # env(HOME) even when user is current user. Assume result contains user # name, else not sure how to check - file tildeexpand ~$::tcl_platform(user)/bar -} -match glob -result "*$::tcl_platform(user)*/bar" + string tolower [file tildeexpand ~$::tcl_platform(user)/bar] +} -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar] test fCmd-32.10 {file tildeexpand ~UNKNOWNUSER} -body { file tildeexpand ~nosuchuser/foo } -returnCodes error -result {user "nosuchuser" doesn't exist} @@ -2679,8 +2741,15 @@ test fCmd-32.16 {file tildeexpand ~USER\\bar} -body { # Note - as in 8.x this form does NOT necessarily give same result as # env(HOME) even when user is current user. Assume result contains user # name, else not sure how to check - file tildeexpand ~$::tcl_platform(user)\\bar -} -constraints win -match glob -result "*$::tcl_platform(user)*/bar" + string tolower [file tildeexpand ~$::tcl_platform(user)\\bar] +} -constraints win -match glob -result [file join [gethomedirglob $::tcl_platform(user)] bar] +test fCmd-32.17 {file tildeexpand ~USER does not mirror HOME} -setup { + set ::env(HOME) [file join $::env(HOME) foo] +} -cleanup { + set ::env(HOME) [file dirname $::env(HOME)] +} -body { + string tolower [file tildeexpand ~$::tcl_platform(user)] +} -match glob -result [gethomedirglob $::tcl_platform(user)] # cleanup diff --git a/tests/fileName.test b/tests/fileName.test index 04273d7..b147bd7 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -18,6 +18,7 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] +source [file join [file dirname [info script]] tcltests.tcl] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testtranslatefilename [llength [info commands testtranslatefilename]] @@ -201,7 +202,7 @@ test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} { test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split //foo -} "/ foo" +} "//foo" test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} { testsetplatform unix file split foo//bar @@ -438,14 +439,14 @@ test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} { test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join //a b -} "/a/b" +} "//a/b" test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} { testsetplatform unix file join /// a b } "/a/b" test filename-7.19 {[Bug f34cf83dd0]} { file join foo //bar -} /bar +} //bar test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} { testsetplatform win @@ -1345,7 +1346,7 @@ catch {file attributes globTest/a1 -permissions 0o755} test filename-15.4 {unix specific no complain: no errors, good result} \ {unix nonPortable} { # test fails because if an error occurs, the interp's result is reset... - # or you don't run at scriptics where the outser and welch users exists + # or you don't run at scriptics where the ouster and welch users exists glob -nocomplain ~ouster ~foo ~welch } {/home/ouster /home/welch} test filename-15.4.1 {no complain: errors, sequencing} { @@ -1629,6 +1630,61 @@ test fileName-20.10 {globbing for special chars} -setup { removeFile fileName-20.10 $s removeDirectory sub ~ } -result ~/sub/fileName-20.10 + + +apply [list {} { + test fileName-6d4e9d1af5bf5b7d { + memory leak in SetFsPathFromAny + + Runs under both a TCL_DEBUG_MEM build and a -DPURIFY build for + valgrind, which is useful since Valgrind provides information about the + error location, but [memory] doesn't. + } -setup { + if {[namespace which ::memory] eq {}} { + set memcheckcmd [list ::apply [list script { + uplevel 1 $script + return 0 + } [namespace current]]] + } else { + set memcheckcmd ::tcltests::scriptmemcheck + } + } -body { + {*}$memcheckcmd { + set interp [interp create] + interp eval $interp { + apply [list {} { + upvar 1 f f + + # A unique name so that no internal representation of this + # literal value has been picked up from any other script + # that has alredy been sourced into this interpreter. + set variableUniqueInTheEntireTclCodebase a + set name variableUniqueInTheEntireTclCodebase + + # give the Tcl_Obj for "var1" an internal representation of + # type 'localVarNameType'. + set $name + + set f [open variableUniqueInTheEntireTclCodebase w] + try { + puts $f {some data} + } finally { + close $f + } + + set f [open variableUniqueInTheEntireTclCodebase] + try { + read $f + } finally { + catch {file delete variableUniqueInTheEntireTclCodebase} + close $f + } + } [namespace current]] + } + interp delete $interp + } + } -result 0 +} [namespace current]] # cleanup catch {file delete -force C:/globTest} diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 0b53be5..d62a59a 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -276,6 +276,16 @@ test filesystem-1.30.1 {normalisation of existing user} -body { test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body { file normalize ~nonexistentuser@nonexistentdomain } -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist} +test filesystem-1.30.3 {file normalization should distinguish between ~ and ~user} -setup { + set oldhome $::env(HOME) + set olduserhome [file normalize ~$::tcl_platform(user)] + set ::env(HOME) [file join $oldhome temp] +} -cleanup { + set env(HOME) $oldhome +} -body { + list [string equal [file normalize ~] $::env(HOME)] \ + [string equal $olduserhome [file normalize ~$::tcl_platform(user)]] +} -result {1 1} test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} { testsetplatform unix file normalize /foo/../bar @@ -288,7 +298,7 @@ test filesystem-1.33 {link normalisation: link near filesystem root} {testsetpla testsetplatform windows set res [file normalize C:/../bar] if {[testConstraint unix]} { - # Some unices go further in normalizing this -- not really a problem + # Some Unices go further in normalizing this -- not really a problem # since this is a Windows test. regexp {C:/bar$} $res res } @@ -379,13 +389,13 @@ test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} { test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} { testPathEqual [file norm /../../] [file norm /] } ok -test filesystem-1.52 {bug f9f390d0fa: file join where strep is not canonical} -constraints unix -body { - set x //foo +test filesystem-1.52 {bug f9f390d0fa: file join where strep is not canonical} -body { + set x ///foo file normalize $x file join $x bar } -result /foo/bar test filesystem-1.52.1 {bug f9f390d0fa: file join where strep is not canonical} -body { - set x //foo + set x ///foo file normalize $x file join $x } -result /foo @@ -682,7 +692,7 @@ test filesystem-7.4 {cross-filesystem file copy with -force} -setup { file delete -force simplefile file delete -force file2 cd $dir -} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} +} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file exists} 0 {} 1} test filesystem-7.5 {cross-filesystem file copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] @@ -707,7 +717,7 @@ test filesystem-7.5 {cross-filesystem file copy with -force} -setup { file delete -force simplefile file delete -force file2 cd $dir -} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1} +} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file exists} 0 {} 1} test filesystem-7.6 {cross-filesystem dir copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] @@ -735,7 +745,7 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} -setup { file delete -force simpledir file delete -force dir2 cd $dir -} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} +} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file exists} 0 {} 1 1} test filesystem-7.7 {cross-filesystem dir copy with -force} -setup { set dir [pwd] cd [tcltest::temporaryDirectory] @@ -765,7 +775,7 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} -setup { file delete -force simpledir file delete -force dir2 cd $dir -} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1} +} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file exists} 0 {} 1 1} removeFile gorp.file test filesystem-7.8 {vfs cd} -setup { set dir [pwd] diff --git a/tests/fileSystemEncoding.test b/tests/fileSystemEncoding.test index c9d36d2..f47635d 100644 --- a/tests/fileSystemEncoding.test +++ b/tests/fileSystemEncoding.test @@ -15,20 +15,7 @@ namespace eval ::tcl::test::fileSystemEncoding { variable fname1 登鸛鵲樓 - proc autopath {} { - global auto_path - set scriptpath [info script] - set scriptpathnorm [file dirname [file normalize $scriptpath/...]] - set dirnorm [file dirname $scriptpathnorm] - set idx [lsearch -exact $auto_path $dirnorm] - if {$idx >= 0} { - set auto_path [lreplace $auto_path[set auto_path {}] $idx $idx {}] - } - set auto_path [linsert $auto_path[set auto_path {}] 0 0 $dirnorm] - } - autopath - - package require tcltests + source [file join [file dirname [info script]] tcltests.tcl] test filesystemEncoding-1.0 { issue bcd100410465 diff --git a/tests/for.test b/tests/for.test index 8284a09..26300ce 100644 --- a/tests/for.test +++ b/tests/for.test @@ -337,7 +337,7 @@ proc formatMail {} { 50 {} \ 51 {Binary Releases} \ 52 {} \ - 53 {Pre-compiled releases are available for the following platforms: } \ + 53 {Precompiled releases are available for the following platforms: } \ 54 {} \ 55 { Windows 3.1, Windows 95, and Windows NT: Fetch} \ 56 { ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \ @@ -556,7 +556,7 @@ Obtaining The Releases Binary Releases -Pre-compiled releases are available for the following +Precompiled releases are available for the following platforms: Windows 3.1, Windows 95, and Windows NT: Fetch diff --git a/tests/http.test b/tests/http.test index e88210a..e9a0b31 100644 --- a/tests/http.test +++ b/tests/http.test @@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] package require http 2.10 @@ -47,6 +47,7 @@ if {![file exists $httpdFile]} { catch {package require Thread 2.7-} if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} { set httpthread [thread::create -preserved] + lappend threadStack [list thread::release $httpthread] thread::send $httpthread [list source $httpdFile] thread::send $httpthread [list set bindata $bindata] thread::send $httpthread {httpd_init 0; set port} port @@ -64,6 +65,7 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} { catch {unset port} return } + set threadStack {} } if {![info exists ThreadLevel]} { @@ -78,6 +80,9 @@ if {![info exists ThreadLevel]} { foreach ThreadLevel $ValueRange { source [info script] } + if {[llength $threadStack]} { + eval [lpop threadStack] + } catch {unset ThreadLevel} catch {unset ValueRange} return @@ -86,17 +91,17 @@ if {![info exists ThreadLevel]} { catch {puts "==== Test with ThreadLevel $ThreadLevel ===="} http::config -threadlevel $ThreadLevel -test http-1.1 {http::config} { +test http-1.1.$ThreadLevel {http::config} { http::config -useragent UserAgent http::config -} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -threadlevel $ThreadLevel -urlencoding utf-8 -useragent UserAgent -zip 1] -test http-1.2 {http::config} { +} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyauth {} -proxyfilter http::ProxyRequired -proxyhost {} -proxynot {} -proxyport {} -repost 0 -threadlevel $ThreadLevel -urlencoding utf-8 -useragent UserAgent -zip 1] +test http-1.2.$ThreadLevel {http::config} { http::config -proxyfilter } http::ProxyRequired -test http-1.3 {http::config} { +test http-1.3.$ThreadLevel {http::config} { catch {http::config -junk} } 1 -test http-1.4 {http::config} { +test http-1.4.$ThreadLevel {http::config} { set savedconf [http::config] http::config -proxyhost nowhere.come -proxyport 8080 \ -proxyfilter myFilter -useragent "Tcl Test Suite" \ @@ -104,11 +109,11 @@ test http-1.4 {http::config} { set x [http::config] http::config {*}$savedconf set x -} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -threadlevel $ThreadLevel -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1] -test http-1.5 {http::config} -returnCodes error -body { +} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyauth {} -proxyfilter myFilter -proxyhost nowhere.come -proxynot {} -proxyport 8080 -repost 0 -threadlevel $ThreadLevel -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1] +test http-1.5.$ThreadLevel {http::config} -returnCodes error -body { http::config -proxyhost {} -junk 8080 -} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -threadlevel, -urlencoding, -useragent, -zip} -test http-1.6 {http::config} -setup { +} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyauth, -proxyfilter, -proxyhost, -proxynot, -proxyport, -repost, -threadlevel, -urlencoding, -useragent, -zip} +test http-1.6.$ThreadLevel {http::config} -setup { set oldenc [http::config -urlencoding] } -body { set enc [list [http::config -urlencoding]] @@ -118,42 +123,42 @@ test http-1.6 {http::config} -setup { http::config -urlencoding $oldenc } -result {utf-8 iso8859-1} -test http-2.1 {http::reset} { +test http-2.1.$ThreadLevel {http::reset} { catch {http::reset http#1} } 0 -test http-2.2 {http::CharsetToEncoding} { +test http-2.2.$ThreadLevel {http::CharsetToEncoding} { http::CharsetToEncoding iso-8859-11 } iso8859-11 -test http-2.3 {http::CharsetToEncoding} { +test http-2.3.$ThreadLevel {http::CharsetToEncoding} { http::CharsetToEncoding iso-2022-kr } iso2022-kr -test http-2.4 {http::CharsetToEncoding} { +test http-2.4.$ThreadLevel {http::CharsetToEncoding} { http::CharsetToEncoding shift-jis } shiftjis -test http-2.5 {http::CharsetToEncoding} { +test http-2.5.$ThreadLevel {http::CharsetToEncoding} { http::CharsetToEncoding windows-437 } cp437 -test http-2.6 {http::CharsetToEncoding} { +test http-2.6.$ThreadLevel {http::CharsetToEncoding} { http::CharsetToEncoding latin5 } iso8859-9 -test http-2.7 {http::CharsetToEncoding} { +test http-2.7.$ThreadLevel {http::CharsetToEncoding} { http::CharsetToEncoding latin1 } iso8859-1 -test http-2.8 {http::CharsetToEncoding} { +test http-2.8.$ThreadLevel {http::CharsetToEncoding} { http::CharsetToEncoding latin4 } binary -test http-3.1 {http::geturl} -returnCodes error -body { +test http-3.1.$ThreadLevel {http::geturl} -returnCodes error -body { http::geturl -bogus flag } -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -guesstype, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate} -test http-3.2 {http::geturl} -returnCodes error -body { +test http-3.2.$ThreadLevel {http::geturl} -returnCodes error -body { http::geturl http:junk } -result {Unsupported URL: http:junk} set url //${::HOST}:$port set badurl //${::HOST}:[expr {$port+1}] -test http-3.3 {http::geturl} -body { +test http-3.3.$ThreadLevel {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { @@ -173,7 +178,7 @@ set badposturl //${::HOST}:$port/droppost set authorityurl //${::HOST}:$port set ipv6url http://\[::1\]:$port/ -test http-3.4 {http::geturl} -body { +test http-3.4.$ThreadLevel {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { @@ -186,7 +191,7 @@ proc selfproxy {host} { global port return [list ${::HOST} $port] } -test http-3.5 {http::geturl} -body { +test http-3.5.$ThreadLevel {http::geturl} -body { http::config -proxyfilter selfproxy set token [http::geturl $url] http::data $token @@ -197,7 +202,7 @@ test http-3.5 {http::geturl} -body { <h1>Hello, World!</h1> <h2>GET http:$url</h2> </body></html>" -test http-3.6 {http::geturl} -body { +test http-3.6.$ThreadLevel {http::geturl} -body { http::config -proxyfilter bogus set token [http::geturl $url] http::data $token @@ -208,7 +213,7 @@ test http-3.6 {http::geturl} -body { <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" -test http-3.7 {http::geturl} -body { +test http-3.7.$ThreadLevel {http::geturl} -body { set token [http::geturl $url -headers {Pragma no-cache}] http::data $token } -cleanup { @@ -217,7 +222,7 @@ test http-3.7 {http::geturl} -body { <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" -test http-3.8 {http::geturl} -body { +test http-3.8.$ThreadLevel {http::geturl} -body { set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000] http::data $token } -cleanup { @@ -231,13 +236,13 @@ test http-3.8 {http::geturl} -body { <dt>Foo<dd>Bar </dl> </body></html>" -test http-3.9 {http::geturl} -body { +test http-3.9.$ThreadLevel {http::geturl} -body { set token [http::geturl $url -validate 1] http::code $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 200 OK" -test http-3.10 {http::geturl queryprogress} -setup { +test http-3.10.$ThreadLevel {http::geturl queryprogress} -setup { set query foo=bar set sep "" set i 0 @@ -260,7 +265,7 @@ test http-3.10 {http::geturl queryprogress} -setup { } -cleanup { http::cleanup $t } -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}} -test http-3.11 {http::geturl querychannel with -command} -setup { +test http-3.11.$ThreadLevel {http::geturl querychannel with -command} -setup { set query foo=bar set sep "" set i 0 @@ -299,7 +304,7 @@ test http-3.11 {http::geturl querychannel with -command} -setup { # The status is "eof". # On Windows, the http::wait procedure gets a "connection reset by peer" error # while reading the reply. -test http-3.12 {http::geturl querychannel with aborted request} -setup { +test http-3.12.$ThreadLevel {http::geturl querychannel with aborted request} -setup { set query foo=bar set sep "" set i 0 @@ -337,7 +342,7 @@ test http-3.12 {http::geturl querychannel with aborted request} -setup { removeFile outdata http::cleanup $t } -result {ok {HTTP/1.0 200 Data follows}} -test http-3.13 {http::geturl socket leak test} { +test http-3.13.$ThreadLevel {http::geturl socket leak test} { set chanCount [llength [file channels]] for {set i 0} {$i < 3} {incr i} { catch {http::geturl $badurl -timeout 5000} @@ -345,43 +350,43 @@ test http-3.13 {http::geturl socket leak test} { # No extra channels should be taken expr {[llength [file channels]] == $chanCount} } 1 -test http-3.14 "http::geturl $fullurl" -body { +test http-3.14.$ThreadLevel "http::geturl $fullurl" -body { set token [http::geturl $fullurl -validate 1] http::code $token } -cleanup { http::cleanup $token } -result "HTTP/1.0 200 OK" -test http-3.15 {http::geturl parse failures} -body { +test http-3.15.$ThreadLevel {http::geturl parse failures} -body { http::geturl "{invalid}:url" } -returnCodes error -result {Unsupported URL: {invalid}:url} -test http-3.16 {http::geturl parse failures} -body { +test http-3.16.$ThreadLevel {http::geturl parse failures} -body { http::geturl http:relative/url } -returnCodes error -result {Unsupported URL: http:relative/url} -test http-3.17 {http::geturl parse failures} -body { +test http-3.17.$ThreadLevel {http::geturl parse failures} -body { http::geturl /absolute/url } -returnCodes error -result {Missing host part: /absolute/url} -test http-3.18 {http::geturl parse failures} -body { +test http-3.18.$ThreadLevel {http::geturl parse failures} -body { http::geturl http://somewhere:123456789/ } -returnCodes error -result {Invalid port number: 123456789} -test http-3.19 {http::geturl parse failures} -body { +test http-3.19.$ThreadLevel {http::geturl parse failures} -body { http::geturl http://{user}@somewhere } -returnCodes error -result {Illegal characters in URL user} -test http-3.20 {http::geturl parse failures} -body { +test http-3.20.$ThreadLevel {http::geturl parse failures} -body { http::geturl http://%user@somewhere } -returnCodes error -result {Illegal encoding character usage "%us" in URL user} -test http-3.21 {http::geturl parse failures} -body { +test http-3.21.$ThreadLevel {http::geturl parse failures} -body { http::geturl http://somewhere/{path} } -returnCodes error -result {Illegal characters in URL path} -test http-3.22 {http::geturl parse failures} -body { +test http-3.22.$ThreadLevel {http::geturl parse failures} -body { http::geturl http://somewhere/%path } -returnCodes error -result {Illegal encoding character usage "%pa" in URL path} -test http-3.23 {http::geturl parse failures} -body { +test http-3.23.$ThreadLevel {http::geturl parse failures} -body { http::geturl http://somewhere/path?{query}? } -returnCodes error -result {Illegal characters in URL path} -test http-3.24 {http::geturl parse failures} -body { +test http-3.24.$ThreadLevel {http::geturl parse failures} -body { http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} -test http-3.25 {http::meta} -setup { +test http-3.25.$ThreadLevel {http::meta} -setup { unset -nocomplain m token } -body { set token [http::geturl $url -timeout 3000] @@ -391,7 +396,7 @@ test http-3.25 {http::meta} -setup { http::cleanup $token unset -nocomplain m token } -result {content-length content-type date} -test http-3.26 {http::meta} -setup { +test http-3.26.$ThreadLevel {http::meta} -setup { unset -nocomplain m token } -body { set token [http::geturl $url -headers {X-Check 1} -timeout 3000] @@ -401,7 +406,7 @@ test http-3.26 {http::meta} -setup { http::cleanup $token unset -nocomplain m token } -result {content-length content-type date x-check} -test http-3.27 {http::geturl: -headers override -type} -body { +test http-3.27.$ThreadLevel {http::geturl: -headers override -type} -body { set token [http::geturl $url/headers -type "text/plain" -query dummy \ -headers [list "Content-Type" "text/plain;charset=utf-8"]] http::data $token @@ -409,12 +414,12 @@ test http-3.27 {http::geturl: -headers override -type} -body { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* -Connection close Content-Type {text/plain;charset=utf-8} Accept \*/\* Accept-Encoding .* +Connection close Content-Length 5} -test http-3.28 {http::geturl: -headers override -type default} -body { +test http-3.28.$ThreadLevel {http::geturl: -headers override -type default} -body { set token [http::geturl $url/headers -query dummy \ -headers [list "Content-Type" "text/plain;charset=utf-8"]] http::data $token @@ -422,12 +427,12 @@ test http-3.28 {http::geturl: -headers override -type default} -body { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* -Connection close Content-Type {text/plain;charset=utf-8} Accept \*/\* Accept-Encoding .* +Connection close Content-Length 5} -test http-3.29 {http::geturl IPv6 address} -body { +test http-3.29.$ThreadLevel {http::geturl IPv6 address} -body { # We only want to see if the URL gets parsed correctly. This is # the case if http::geturl succeeds or returns a socket related # error. If the parsing is wrong, we'll get a parse error. @@ -441,20 +446,20 @@ test http-3.29 {http::geturl IPv6 address} -body { } -cleanup { catch { http::cleanup $token } } -result 0 -test http-3.30 {http::geturl query without path} -body { +test http-3.30.$ThreadLevel {http::geturl query without path} -body { set token [http::geturl $authorityurl?var=val] http::ncode $token } -cleanup { catch { http::cleanup $token } } -result 200 -test http-3.31 {http::geturl fragment without path} -body { +test http-3.31.$ThreadLevel {http::geturl fragment without path} -body { set token [http::geturl "$authorityurl#fragment42"] http::ncode $token } -cleanup { catch { http::cleanup $token } } -result 200 # Bug c11a51c482 -test http-3.32 {http::geturl: -headers override -accept default} -body { +test http-3.32.$ThreadLevel {http::geturl: -headers override -accept default} -body { set token [http::geturl $url/headers -query dummy \ -headers [list "Accept" "text/plain,application/tcl-test-value"]] http::data $token @@ -462,26 +467,26 @@ test http-3.32 {http::geturl: -headers override -accept default} -body { http::cleanup $token } -match regexp -result {(?n)Host .* User-Agent .* -Connection close Accept text/plain,application/tcl-test-value Accept-Encoding .* +Connection close Content-Type application/x-www-form-urlencoded Content-Length 5} # Bug 838e99a76d -test http-3.33 {http::geturl application/xml is text} -body { +test http-3.33.$ThreadLevel {http::geturl application/xml is text} -body { set token [http::geturl "$xmlurl"] scan [http::data $token] "<%\[^>]>%c<%\[^>]>" } -cleanup { catch { http::cleanup $token } } -result {test 4660 /test} -test http-3.34 {http::geturl -headers not a list} -returnCodes error -body { +test http-3.34.$ThreadLevel {http::geturl -headers not a list} -returnCodes error -body { http::geturl http://test/t -headers \" } -result {Bad value for -headers ("), must be list} -test http-3.35 {http::geturl -headers not even number of elements} -returnCodes error -body { +test http-3.35.$ThreadLevel {http::geturl -headers not even number of elements} -returnCodes error -body { http::geturl http://test/t -headers {List Length 3} } -result {Bad value for -headers (List Length 3), number of list elements must be even} -test http-4.1 {http::Event} -body { +test http-4.1.$ThreadLevel {http::Event} -body { set token [http::geturl $url -keepalive 0] upvar #0 $token data array set meta $data(meta) @@ -489,7 +494,7 @@ test http-4.1 {http::Event} -body { } -cleanup { http::cleanup $token } -result 1 -test http-4.2 {http::Event} -body { +test http-4.2.$ThreadLevel {http::Event} -body { set token [http::geturl $url] upvar #0 $token data array set meta $data(meta) @@ -497,13 +502,13 @@ test http-4.2 {http::Event} -body { } -cleanup { http::cleanup $token } -result 0 -test http-4.3 {http::Event} -body { +test http-4.3.$ThreadLevel {http::Event} -body { set token [http::geturl $url] http::code $token } -cleanup { http::cleanup $token } -result {HTTP/1.0 200 Data follows} -test http-4.4 {http::Event} -setup { +test http-4.4.$ThreadLevel {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] @@ -520,7 +525,7 @@ test http-4.4 {http::Event} -setup { <h1>Hello, World!</h1> <h2>GET $tail</h2> </body></html>" -test http-4.5 {http::Event} -setup { +test http-4.5.$ThreadLevel {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] @@ -533,7 +538,7 @@ test http-4.5 {http::Event} -setup { removeFile $testfile http::cleanup $token } -result 1 -test http-4.6 {http::Event} -setup { +test http-4.6.$ThreadLevel {http::Event} -setup { set testfile [makeFile "" testfile] } -body { set out [open $testfile w] @@ -555,29 +560,29 @@ proc myProgress {token total current} { } set progress [list $total $current] } -test http-4.6.1 {http::Event} knownBug { +test http-4.6.1.$ThreadLevel {http::Event} knownBug { set token [http::geturl $url -blocksize 50 -progress myProgress] return $progress } {111 111} -test http-4.7 {http::Event} -body { +test http-4.7.$ThreadLevel {http::Event} -body { set token [http::geturl $url -keepalive 0 -progress myProgress] return $progress } -cleanup { http::cleanup $token } -result {111 111} -test http-4.8 {http::Event} -body { +test http-4.8.$ThreadLevel {http::Event} -body { set token [http::geturl $url] http::status $token } -cleanup { http::cleanup $token } -result {ok} -test http-4.9 {http::Event} -body { +test http-4.9.$ThreadLevel {http::Event} -body { set token [http::geturl $url -progress myProgress] http::code $token } -cleanup { http::cleanup $token } -result {HTTP/1.0 200 Data follows} -test http-4.10 {http::Event} -body { +test http-4.10.$ThreadLevel {http::Event} -body { set token [http::geturl $url -progress myProgress] http::size $token } -cleanup { @@ -587,7 +592,7 @@ test http-4.10 {http::Event} -body { # Timeout cases # Short timeout to working server (the test server). This lets us try a # reset during the connection. -test http-4.11 {http::Event} -body { +test http-4.11.$ThreadLevel {http::Event} -body { set token [http::geturl $url -timeout 1 -keepalive 0 -command \#] http::reset $token http::status $token @@ -596,7 +601,7 @@ test http-4.11 {http::Event} -body { } -result {reset} # Longer timeout with reset. -test http-4.12 {http::Event} -body { +test http-4.12.$ThreadLevel {http::Event} -body { set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#] http::reset $token http::status $token @@ -606,7 +611,7 @@ test http-4.12 {http::Event} -body { # Medium timeout to working server that waits even longer. The timeout # hits while waiting for a reply. -test http-4.13 {http::Event} -body { +test http-4.13.$ThreadLevel {http::Event} -body { set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#] http::wait $token http::status $token @@ -616,7 +621,7 @@ test http-4.13 {http::Event} -body { # Longer timeout to good host, bad port, gets an error after the # connection "completes" but the socket is bad. -test http-4.14 {http::Event} -body { +test http-4.14.$ThreadLevel {http::Event} -body { set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#] if {$token eq ""} { error "bogus return from http::geturl" @@ -625,13 +630,16 @@ test http-4.14 {http::Event} -body { lindex [http::error $token] 0 } -cleanup { catch {http::cleanup $token} -} -result {connect failed connection refused} +} -result {connect failed: connection refused} # Bogus host -test http-4.15 {http::Event} -body { +test http-4.15.$ThreadLevel {http::Event} -body { # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. - set token [http::geturl //not_a_host.tcl.tk -timeout 3000 -command \#] + # With http::config -threadlevel 1 or 2, the script enters the event loop + # during the DNS lookup, and has the opportunity to time out. + # Increase -timeout from 3000 to 10000 to prevent this. + set token [http::geturl //not_a_host.tcl.tk -timeout 10000 -command \#] http::wait $token set result "[http::status $token] -- [lindex [http::error $token] 0]" # error codes vary among platforms. @@ -639,7 +647,7 @@ test http-4.15 {http::Event} -body { catch {http::cleanup $token} } -match glob -result "error -- couldn't open socket*" -test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup { +test http-4.16.$ThreadLevel {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup { proc list-difference {l1 l2} { lmap item $l2 {if {$item in $l1} continue; set item} } @@ -654,17 +662,17 @@ test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup { rename list-difference {} } -result {} -test http-5.1 {http::formatQuery} { +test http-5.1.$ThreadLevel {http::formatQuery} { http::formatQuery name1 value1 name2 "value two" } {name1=value1&name2=value%20two} # test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5 -test http-5.3 {http::formatQuery} { +test http-5.3.$ThreadLevel {http::formatQuery} { http::formatQuery lines "line1\nline2\nline3" } {lines=line1%0D%0Aline2%0D%0Aline3} -test http-5.4 {http::formatQuery} { +test http-5.4.$ThreadLevel {http::formatQuery} { http::formatQuery name1 ~bwelch name2 ¡¢¢ } {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2} -test http-5.5 {http::formatQuery} { +test http-5.5.$ThreadLevel {http::formatQuery} { set enc [http::config -urlencoding] http::config -urlencoding iso8859-1 set res [http::formatQuery name1 ~bwelch name2 ¡¢¢] @@ -672,7 +680,7 @@ test http-5.5 {http::formatQuery} { set res } {name1=~bwelch&name2=%A1%A2%A2} -test http-6.1 {http::ProxyRequired} -body { +test http-6.1.$ThreadLevel {http::ProxyRequired} -body { http::config -proxyhost ${::HOST} -proxyport $port set token [http::geturl $url] http::wait $token @@ -686,15 +694,15 @@ test http-6.1 {http::ProxyRequired} -body { <h2>GET http:$url</h2> </body></html>" -test http-7.1 {http::mapReply} { +test http-7.1.$ThreadLevel {http::mapReply} { http::mapReply "abc\$\[\]\"\\()\}\{" } {abc%24%5B%5D%22%5C%28%29%7D%7B} -test http-7.2 {http::mapReply} { +test http-7.2.$ThreadLevel {http::mapReply} { # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default, # so make sure this gets converted to utf-8 then urlencoded. http::mapReply "∈" } {%E2%88%88} -test http-7.3 {http::formatQuery} -setup { +test http-7.3.$ThreadLevel {http::formatQuery} -setup { set enc [http::config -urlencoding] } -returnCodes error -body { # -urlencoding "" no longer supported. Use "iso8859-1". @@ -703,7 +711,7 @@ test http-7.3 {http::formatQuery} -setup { } -cleanup { http::config -urlencoding $enc } -result {unknown encoding ""} -test http-7.4 {http::formatQuery} -constraints deprecated -setup { +test http-7.4.$ThreadLevel {http::formatQuery} -constraints deprecated -setup { set enc [http::config -urlencoding] } -body { # this would be reverting to http <=2.4 behavior w/o errors @@ -717,113 +725,113 @@ test http-7.4 {http::formatQuery} -constraints deprecated -setup { package require tcl::idna 1.0 -test http-idna-1.1 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.1.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna } -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"} -test http-idna-1.2 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.2.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna ? } -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} -test http-idna-1.3 {IDNA package: basics} -body { +test http-idna-1.3.$ThreadLevel {IDNA package: basics} -body { ::tcl::idna version } -result 1.0.1 -test http-idna-1.4 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.4.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna version what } -result {wrong # args: should be "::tcl::idna version"} -test http-idna-1.5 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.5.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny } -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"} -test http-idna-1.6 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.6.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny ? } -result {unknown or ambiguous subcommand "?": must be decode, or encode} -test http-idna-1.7 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.7.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny encode } -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} -test http-idna-1.8 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.8.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny encode a b c } -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} -test http-idna-1.9 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.9.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny decode } -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} -test http-idna-1.10 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.10.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny decode a b c } -result {wrong # args: should be "::tcl::idna puny decode string ?case?"} -test http-idna-1.11 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.11.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna decode } -result {wrong # args: should be "::tcl::idna decode hostname"} -test http-idna-1.12 {IDNA package: basics} -returnCodes error -body { +test http-idna-1.12.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna encode } -result {wrong # args: should be "::tcl::idna encode hostname"} -test http-idna-2.1 {puny encode: functional test} { +test http-idna-2.1.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode abc } abc- -test http-idna-2.2 {puny encode: functional test} { +test http-idna-2.2.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode a€b€c } abc-k50ab -test http-idna-2.3 {puny encode: functional test} { +test http-idna-2.3.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode ABC } ABC- -test http-idna-2.4 {puny encode: functional test} { +test http-idna-2.4.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode A€B€C } ABC-k50ab -test http-idna-2.5 {puny encode: functional test} { +test http-idna-2.5.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode ABC 0 } abc- -test http-idna-2.6 {puny encode: functional test} { +test http-idna-2.6.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode A€B€C 0 } abc-k50ab -test http-idna-2.7 {puny encode: functional test} { +test http-idna-2.7.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode ABC 1 } ABC- -test http-idna-2.8 {puny encode: functional test} { +test http-idna-2.8.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode A€B€C 1 } ABC-k50ab -test http-idna-2.9 {puny encode: functional test} { +test http-idna-2.9.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode abc 0 } abc- -test http-idna-2.10 {puny encode: functional test} { +test http-idna-2.10.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode a€b€c 0 } abc-k50ab -test http-idna-2.11 {puny encode: functional test} { +test http-idna-2.11.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode abc 1 } ABC- -test http-idna-2.12 {puny encode: functional test} { +test http-idna-2.12.$ThreadLevel {puny encode: functional test} { ::tcl::idna puny encode a€b€c 1 } ABC-k50ab -test http-idna-2.13 {puny encode: edge cases} { +test http-idna-2.13.$ThreadLevel {puny encode: edge cases} { ::tcl::idna puny encode "" } "" -test http-idna-2.14-A {puny encode: examples from RFC 3492} { +test http-idna-2.14-A.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644 u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F }]] ""] } egbpdaj6bu4bxfgehfvwxn -test http-idna-2.14-B {puny encode: examples from RFC 3492} { +test http-idna-2.14-B.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587 }]] ""] } ihqwcrb4cv8a8dqg056pqjye -test http-idna-2.14-C {puny encode: examples from RFC 3492} { +test http-idna-2.14-C.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587 }]] ""] } ihqwctvzc91f659drss3x8bo0yb -test http-idna-2.14-D {puny encode: examples from RFC 3492} { +test http-idna-2.14-D.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074 u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D u+0065 u+0073 u+006B u+0079 }]] ""] } Proprostnemluvesky-uyb24dma41a -test http-idna-2.14-E {puny encode: examples from RFC 3492} { +test http-idna-2.14-E.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8 u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2 u+05D1 u+05E8 u+05D9 u+05EA }]] ""] } 4dbcagdahymbxekheh6e0a7fei0b -test http-idna-2.14-F {puny encode: examples from RFC 3492} { +test http-idna-2.14-F.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939 @@ -831,20 +839,20 @@ test http-idna-2.14-F {puny encode: examples from RFC 3492} { u+0939 u+0948 u+0902 }]] ""] } i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd -test http-idna-2.14-G {puny encode: examples from RFC 3492} { +test http-idna-2.14-G.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092 u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B }]] ""] } n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa -test http-idna-2.14-H {puny encode: examples from RFC 3492} { +test http-idna-2.14-H.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774 u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C }]] ""] } 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c -test http-idna-2.14-I {puny encode: examples from RFC 3492} { +test http-idna-2.14-I.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440 @@ -852,7 +860,7 @@ test http-idna-2.14-I {puny encode: examples from RFC 3492} { u+0438 }]] ""] } b1abfaaepdrnnbgefbadotcwatmq2g4l -test http-idna-2.14-J {puny encode: examples from RFC 3492} { +test http-idna-2.14-J.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070 u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070 @@ -861,7 +869,7 @@ test http-idna-2.14-J {puny encode: examples from RFC 3492} { u+0061 u+00F1 u+006F u+006C }]] ""] } PorqunopuedensimplementehablarenEspaol-fmd56a -test http-idna-2.14-K {puny encode: examples from RFC 3492} { +test http-idna-2.14-K.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068 @@ -869,135 +877,135 @@ test http-idna-2.14-K {puny encode: examples from RFC 3492} { u+0056 u+0069 u+1EC7 u+0074 }]] ""] } TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g -test http-idna-2.14-L {puny encode: examples from RFC 3492} { +test http-idna-2.14-L.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F }]] ""] } 3B-ww4c5e180e575a65lsy2b -test http-idna-2.14-M {puny encode: examples from RFC 3492} { +test http-idna-2.14-M.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074 u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D u+004F u+004E u+004B u+0045 u+0059 u+0053 }]] ""] } -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n -test http-idna-2.14-N {puny encode: examples from RFC 3492} { +test http-idna-2.14-N.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D u+305D u+308C u+305E u+308C u+306E u+5834 u+6240 }]] ""] } Hello-Another-Way--fc4qua05auwb3674vfr0b -test http-idna-2.14-O {puny encode: examples from RFC 3492} { +test http-idna-2.14-O.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032 }]] ""] } 2-u9tlzr9756bt3uc0v -test http-idna-2.14-P {puny encode: examples from RFC 3492} { +test http-idna-2.14-P.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059 u+308B u+0035 u+79D2 u+524D }]] ""] } MajiKoi5-783gue6qz075azm5e -test http-idna-2.14-Q {puny encode: examples from RFC 3492} { +test http-idna-2.14-Q.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0 }]] ""] } de-jg4avhby1noc0d -test http-idna-2.14-R {puny encode: examples from RFC 3492} { +test http-idna-2.14-R.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode [join [subst [string map {u+ \\u} { u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067 }]] ""] } d9juau41awczczp -test http-idna-2.14-S {puny encode: examples from RFC 3492} { +test http-idna-2.14-S.$ThreadLevel {puny encode: examples from RFC 3492} { ::tcl::idna puny encode {-> $1.00 <-} } {-> $1.00 <--} -test http-idna-3.1 {puny decode: functional test} { +test http-idna-3.1.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode abc- } abc -test http-idna-3.2 {puny decode: functional test} { +test http-idna-3.2.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab } a€b€c -test http-idna-3.3 {puny decode: functional test} { +test http-idna-3.3.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode ABC- } ABC -test http-idna-3.4 {puny decode: functional test} { +test http-idna-3.4.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode ABC-k50ab } A€B€C -test http-idna-3.5 {puny decode: functional test} { +test http-idna-3.5.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB } A€B€C -test http-idna-3.6 {puny decode: functional test} { +test http-idna-3.6.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode abc-K50AB } a€b€c -test http-idna-3.7 {puny decode: functional test} { +test http-idna-3.7.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode ABC- 0 } abc -test http-idna-3.8 {puny decode: functional test} { +test http-idna-3.8.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB 0 } a€b€c -test http-idna-3.9 {puny decode: functional test} { +test http-idna-3.9.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode ABC- 1 } ABC -test http-idna-3.10 {puny decode: functional test} { +test http-idna-3.10.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode ABC-K50AB 1 } A€B€C -test http-idna-3.11 {puny decode: functional test} { +test http-idna-3.11.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode abc- 0 } abc -test http-idna-3.12 {puny decode: functional test} { +test http-idna-3.12.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab 0 } a€b€c -test http-idna-3.13 {puny decode: functional test} { +test http-idna-3.13.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode abc- 1 } ABC -test http-idna-3.14 {puny decode: functional test} { +test http-idna-3.14.$ThreadLevel {puny decode: functional test} { ::tcl::idna puny decode abc-k50ab 1 } A€B€C -test http-idna-3.15 {puny decode: edge cases and errors} { +test http-idna-3.15.$ThreadLevel {puny decode: edge cases and errors} { # Is this case actually correct? binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]] } c282c281c280 -test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body { +test http-idna-3.16.$ThreadLevel {puny decode: edge cases and errors} -returnCodes error -body { ::tcl::idna puny decode abc! } -result {bad decode character "!"} -test http-idna-3.17 {puny decode: edge cases and errors} { +test http-idna-3.17.$ThreadLevel {puny decode: edge cases and errors} { catch {::tcl::idna puny decode abc!} -> opt dict get $opt -errorcode } {PUNYCODE BAD_INPUT CHAR} -test http-idna-3.18 {puny decode: edge cases and errors} { +test http-idna-3.18.$ThreadLevel {puny decode: edge cases and errors} { ::tcl::idna puny decode "" } {} # A helper so we don't get lots of crap in failures proc hexify s {lmap c [split $s ""] {format u+%04X [scan $c %c]}} -test http-idna-3.19-A {puny decode: examples from RFC 3492} { +test http-idna-3.19-A.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode egbpdaj6bu4bxfgehfvwxn] } [list {*}{ u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644 u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F }] -test http-idna-3.19-B {puny decode: examples from RFC 3492} { +test http-idna-3.19-B.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode ihqwcrb4cv8a8dqg056pqjye] } {u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587} -test http-idna-3.19-C {puny decode: examples from RFC 3492} { +test http-idna-3.19-C.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode ihqwctvzc91f659drss3x8bo0yb] } {u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587} -test http-idna-3.19-D {puny decode: examples from RFC 3492} { +test http-idna-3.19-D.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode Proprostnemluvesky-uyb24dma41a] } [list {*}{ u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074 u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D u+0065 u+0073 u+006B u+0079 }] -test http-idna-3.19-E {puny decode: examples from RFC 3492} { +test http-idna-3.19-E.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode 4dbcagdahymbxekheh6e0a7fei0b] } [list {*}{ u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8 u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2 u+05D1 u+05E8 u+05D9 u+05EA }] -test http-idna-3.19-F {puny decode: examples from RFC 3492} { +test http-idna-3.19-F.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode \ i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd] } [list {*}{ @@ -1006,13 +1014,13 @@ test http-idna-3.19-F {puny decode: examples from RFC 3492} { u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947 u+0939 u+0948 u+0902 }] -test http-idna-3.19-G {puny decode: examples from RFC 3492} { +test http-idna-3.19-G.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa] } [list {*}{ u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092 u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B }] -test http-idna-3.19-H {puny decode: examples from RFC 3492} { +test http-idna-3.19-H.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode \ 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c] } [list {*}{ @@ -1020,7 +1028,7 @@ test http-idna-3.19-H {puny decode: examples from RFC 3492} { u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C }] -test http-idna-3.19-I {puny decode: examples from RFC 3492} { +test http-idna-3.19-I.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode b1abfaaepdrnnbgefbadotcwatmq2g4l] } [list {*}{ u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E @@ -1028,7 +1036,7 @@ test http-idna-3.19-I {puny decode: examples from RFC 3492} { u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A u+0438 }] -test http-idna-3.19-J {puny decode: examples from RFC 3492} { +test http-idna-3.19-J.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode \ PorqunopuedensimplementehablarenEspaol-fmd56a] } [list {*}{ @@ -1038,7 +1046,7 @@ test http-idna-3.19-J {puny decode: examples from RFC 3492} { u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070 u+0061 u+00F1 u+006F u+006C }] -test http-idna-3.19-K {puny decode: examples from RFC 3492} { +test http-idna-3.19-K.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode \ TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g] } [list {*}{ @@ -1047,70 +1055,70 @@ test http-idna-3.19-K {puny decode: examples from RFC 3492} { u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067 u+0056 u+0069 u+1EC7 u+0074 }] -test http-idna-3.19-L {puny decode: examples from RFC 3492} { +test http-idna-3.19-L.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode 3B-ww4c5e180e575a65lsy2b] } {u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F} -test http-idna-3.19-M {puny decode: examples from RFC 3492} { +test http-idna-3.19-M.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n] } [list {*}{ u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074 u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D u+004F u+004E u+004B u+0045 u+0059 u+0053 }] -test http-idna-3.19-N {puny decode: examples from RFC 3492} { +test http-idna-3.19-N.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode Hello-Another-Way--fc4qua05auwb3674vfr0b] } [list {*}{ u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D u+305D u+308C u+305E u+308C u+306E u+5834 u+6240 }] -test http-idna-3.19-O {puny decode: examples from RFC 3492} { +test http-idna-3.19-O.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode 2-u9tlzr9756bt3uc0v] } {u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032} -test http-idna-3.19-P {puny decode: examples from RFC 3492} { +test http-idna-3.19-P.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode MajiKoi5-783gue6qz075azm5e] } [list {*}{ u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059 u+308B u+0035 u+79D2 u+524D }] -test http-idna-3.19-Q {puny decode: examples from RFC 3492} { +test http-idna-3.19-Q.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode de-jg4avhby1noc0d] } {u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0} -test http-idna-3.19-R {puny decode: examples from RFC 3492} { +test http-idna-3.19-R.$ThreadLevel {puny decode: examples from RFC 3492} { hexify [::tcl::idna puny decode d9juau41awczczp] } {u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067} -test http-idna-3.19-S {puny decode: examples from RFC 3492} { +test http-idna-3.19-S.$ThreadLevel {puny decode: examples from RFC 3492} { ::tcl::idna puny decode {-> $1.00 <--} } {-> $1.00 <-} rename hexify "" -test http-idna-4.1 {IDNA encoding} { +test http-idna-4.1.$ThreadLevel {IDNA encoding} { ::tcl::idna encode abc.def } abc.def -test http-idna-4.2 {IDNA encoding} { +test http-idna-4.2.$ThreadLevel {IDNA encoding} { ::tcl::idna encode a€b€c.def } xn--abc-k50ab.def -test http-idna-4.3 {IDNA encoding} { +test http-idna-4.3.$ThreadLevel {IDNA encoding} { ::tcl::idna encode def.a€b€c } def.xn--abc-k50ab -test http-idna-4.4 {IDNA encoding} { +test http-idna-4.4.$ThreadLevel {IDNA encoding} { ::tcl::idna encode ABC.DEF } ABC.DEF -test http-idna-4.5 {IDNA encoding} { +test http-idna-4.5.$ThreadLevel {IDNA encoding} { ::tcl::idna encode A€B€C.def } xn--ABC-k50ab.def -test http-idna-4.6 {IDNA encoding: invalid edge case} { +test http-idna-4.6.$ThreadLevel {IDNA encoding: invalid edge case} { # Should this be an error? ::tcl::idna encode abc..def } abc..def -test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body { +test http-idna-4.7.$ThreadLevel {IDNA encoding: invalid char} -returnCodes error -body { ::tcl::idna encode abc.$.def } -result {bad character "$" in DNS name} -test http-idna-4.7.1 {IDNA encoding: invalid char} { +test http-idna-4.7.1.$ThreadLevel {IDNA encoding: invalid char} { catch {::tcl::idna encode abc.$.def} -> opt dict get $opt -errorcode } {IDNA INVALID_NAME_CHARACTER {$}} -test http-idna-4.8 {IDNA encoding: empty} { +test http-idna-4.8.$ThreadLevel {IDNA encoding: empty} { ::tcl::idna encode "" } {} set overlong www.[join [subst [string map {u+ \\u} { @@ -1118,44 +1126,44 @@ set overlong www.[join [subst [string map {u+ \\u} { u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74 u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C }]] ""].com -test http-idna-4.9 {IDNA encoding: max lengths from RFC 5890} -body { +test http-idna-4.9.$ThreadLevel {IDNA encoding: max lengths from RFC 5890} -body { ::tcl::idna encode $overlong } -returnCodes error -result "hostname part too long" -test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} { +test http-idna-4.9.1.$ThreadLevel {IDNA encoding: max lengths from RFC 5890} { catch {::tcl::idna encode $overlong} -> opt dict get $opt -errorcode } {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c} unset overlong -test http-idna-4.10 {IDNA encoding: edge cases} { +test http-idna-4.10.$ThreadLevel {IDNA encoding: edge cases} { ::tcl::idna encode passé.example.com } xn--pass-epa.example.com -test http-idna-5.1 {IDNA decoding} { +test http-idna-5.1.$ThreadLevel {IDNA decoding} { ::tcl::idna decode abc.def } abc.def -test http-idna-5.2 {IDNA decoding} { +test http-idna-5.2.$ThreadLevel {IDNA decoding} { # Invalid entry that's just a wrapper ::tcl::idna decode xn--abc-.def } abc.def -test http-idna-5.3 {IDNA decoding} { +test http-idna-5.3.$ThreadLevel {IDNA decoding} { # Invalid entry that's just a wrapper ::tcl::idna decode xn--abc-.xn--def- } abc.def -test http-idna-5.4 {IDNA decoding} { +test http-idna-5.4.$ThreadLevel {IDNA decoding} { # Invalid entry that's just a wrapper ::tcl::idna decode XN--abc-.XN--def- } abc.def -test http-idna-5.5 {IDNA decoding: error cases} -returnCodes error -body { +test http-idna-5.5.$ThreadLevel {IDNA decoding: error cases} -returnCodes error -body { ::tcl::idna decode xn--$$$.example.com } -result {bad decode character "$"} -test http-idna-5.5.1 {IDNA decoding: error cases} { +test http-idna-5.5.1.$ThreadLevel {IDNA decoding: error cases} { catch {::tcl::idna decode xn--$$$.example.com} -> opt dict get $opt -errorcode } {PUNYCODE BAD_INPUT CHAR} -test http-idna-5.6 {IDNA decoding: error cases} -returnCodes error -body { +test http-idna-5.6.$ThreadLevel {IDNA decoding: error cases} -returnCodes error -body { ::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def } -result {exceeded input data} -test http-idna-5.6.1 {IDNA decoding: error cases} { +test http-idna-5.6.1.$ThreadLevel {IDNA decoding: error cases} { catch {::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def} -> opt dict get $opt -errorcode } {PUNYCODE BAD_INPUT LENGTH} @@ -1165,8 +1173,8 @@ catch {unset url} catch {unset badurl} catch {unset port} catch {unset data} -if {[info exists httpthread]} { - thread::release $httpthread +if {[llength $threadStack]} { + eval [lpop threadStack] } else { close $listen } diff --git a/tests/http11.test b/tests/http11.test index 71ef4c7..55e7d39 100644 --- a/tests/http11.test +++ b/tests/http11.test @@ -108,7 +108,7 @@ http::config -threadlevel $ThreadLevel # ------------------------------------------------------------------------- -test http11-1.0 "normal request for document " -setup { +test http11-1.0.$ThreadLevel "normal request for document " -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html -timeout 10000] @@ -119,7 +119,7 @@ test http11-1.0 "normal request for document " -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close} -test http11-1.1 "normal,gzip,non-chunked" -setup { +test http11-1.1.$ThreadLevel "normal,gzip,non-chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ @@ -133,7 +133,7 @@ test http11-1.1 "normal,gzip,non-chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok gzip {} {content-encoding gzip} {}} -test http11-1.2 "normal,deflated,non-chunked" -setup { +test http11-1.2.$ThreadLevel "normal,deflated,non-chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ @@ -146,7 +146,7 @@ test http11-1.2 "normal,deflated,non-chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate {}} -test http11-1.2.1 "normal,deflated,non-chunked,msdeflate" -setup { +test http11-1.2.1.$ThreadLevel "normal,deflated,non-chunked,msdeflate" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1&msdeflate=1 \ @@ -159,7 +159,7 @@ test http11-1.2.1 "normal,deflated,non-chunked,msdeflate" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate {}} -test http11-1.3 "normal,compressed,non-chunked" -constraints badCompress -setup { +test http11-1.3.$ThreadLevel "normal,compressed,non-chunked" -constraints badCompress -setup { # The Tcl "compress" algorithm appears to be incorrect and has been removed. # Bug [a13b9d0ce1]. variable httpd [create_httpd] @@ -174,7 +174,7 @@ test http11-1.3 "normal,compressed,non-chunked" -constraints badCompress -setup halt_httpd } -result {ok {HTTP/1.1 200 OK} ok compress {}} -test http11-1.4 "normal,identity,non-chunked" -setup { +test http11-1.4.$ThreadLevel "normal,identity,non-chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ @@ -187,7 +187,7 @@ test http11-1.4 "normal,identity,non-chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} {}} -test http11-1.5 "normal request for document, unsupported coding" -setup { +test http11-1.5.$ThreadLevel "normal request for document, unsupported coding" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ @@ -200,7 +200,7 @@ test http11-1.5 "normal request for document, unsupported coding" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {}} -test http11-1.6 "normal, specify 1.1 " -setup { +test http11-1.6.$ThreadLevel "normal, specify 1.1 " -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ @@ -214,7 +214,7 @@ test http11-1.6 "normal, specify 1.1 " -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close chunked {connection close} {transfer-encoding chunked}} -test http11-1.7 "normal, 1.1 and keepalive " -setup { +test http11-1.7.$ThreadLevel "normal, 1.1 and keepalive " -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ @@ -227,7 +227,7 @@ test http11-1.7 "normal, 1.1 and keepalive " -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} chunked} -test http11-1.8 "normal, 1.1 and keepalive, server close" -setup { +test http11-1.8.$ThreadLevel "normal, 1.1 and keepalive, server close" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ @@ -240,7 +240,7 @@ test http11-1.8 "normal, 1.1 and keepalive, server close" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {}} -test http11-1.9 "normal,gzip,chunked" -setup { +test http11-1.9.$ThreadLevel "normal,gzip,chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ @@ -253,7 +253,7 @@ test http11-1.9 "normal,gzip,chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok gzip chunked} -test http11-1.10 "normal,deflate,chunked" -setup { +test http11-1.10.$ThreadLevel "normal,deflate,chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ @@ -266,7 +266,7 @@ test http11-1.10 "normal,deflate,chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate chunked} -test http11-1.10.1 "normal,deflate,chunked,msdeflate" -setup { +test http11-1.10.1.$ThreadLevel "normal,deflate,chunked,msdeflate" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html?msdeflate=1 \ @@ -279,7 +279,7 @@ test http11-1.10.1 "normal,deflate,chunked,msdeflate" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate chunked} -test http11-1.11 "normal,compress,chunked" -constraints badCompress -setup { +test http11-1.11.$ThreadLevel "normal,compress,chunked" -constraints badCompress -setup { # The Tcl "compress" algorithm appears to be incorrect and has been removed. # Bug [a13b9d0ce1]. variable httpd [create_httpd] @@ -294,7 +294,7 @@ test http11-1.11 "normal,compress,chunked" -constraints badCompress -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok compress chunked} -test http11-1.12 "normal,identity,chunked" -setup { +test http11-1.12.$ThreadLevel "normal,identity,chunked" -setup { variable httpd [create_httpd] } -body { set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ @@ -307,7 +307,7 @@ test http11-1.12 "normal,identity,chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} chunked} -test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup { +test http11-1.13.$ThreadLevel "normal, 1.1 and keepalive as server default, no zip" -setup { variable httpd [create_httpd] set zipTmp [http::config -zip] http::config -zip 0 @@ -346,7 +346,7 @@ proc progressPause {var token total current} { return } -test http11-2.0 "-channel" -setup { +test http11-2.0.$ThreadLevel "-channel" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -364,7 +364,7 @@ test http11-2.0 "-channel" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close chunked} -test http11-2.1 "-channel, encoding gzip" -setup { +test http11-2.1.$ThreadLevel "-channel, encoding gzip" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -387,7 +387,7 @@ test http11-2.1 "-channel, encoding gzip" -setup { # Cf. Bug [3610253] "CopyChunk does not drain decompressor(s)" # This test failed before the bugfix. # The pass/fail depended on file size. -test http11-2.1.1 "-channel, encoding gzip" -setup { +test http11-2.1.1.$ThreadLevel "-channel, encoding gzip" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] set fileName largedoc.html @@ -408,7 +408,7 @@ test http11-2.1.1 "-channel, encoding gzip" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close gzip chunked -- 0 bytes lost} -test http11-2.2 "-channel, encoding deflate" -setup { +test http11-2.2.$ThreadLevel "-channel, encoding deflate" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -427,7 +427,7 @@ test http11-2.2 "-channel, encoding deflate" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close deflate chunked} -test http11-2.2.1 "-channel, encoding deflate,msdeflate" -setup { +test http11-2.2.1.$ThreadLevel "-channel, encoding deflate,msdeflate" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -446,7 +446,7 @@ test http11-2.2.1 "-channel, encoding deflate,msdeflate" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close deflate chunked} -test http11-2.3 "-channel,encoding compress" -constraints badCompress -setup { +test http11-2.3.$ThreadLevel "-channel,encoding compress" -constraints badCompress -setup { # The Tcl "compress" algorithm appears to be incorrect and has been removed. # Bug [a13b9d0ce1]. variable httpd [create_httpd] @@ -468,7 +468,7 @@ test http11-2.3 "-channel,encoding compress" -constraints badCompress -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close compress chunked} -test http11-2.4 "-channel,encoding identity" -setup { +test http11-2.4.$ThreadLevel "-channel,encoding identity" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -488,7 +488,7 @@ test http11-2.4 "-channel,encoding identity" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} chunked} -test http11-2.4.1 "-channel,encoding identity with -progress" -setup { +test http11-2.4.1.$ThreadLevel "-channel,encoding identity with -progress" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] set logdata "" @@ -514,7 +514,7 @@ test http11-2.4.1 "-channel,encoding identity with -progress" -setup { unset -nocomplain logdata data } -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0} -test http11-2.4.2 "-channel,encoding identity with -progress progressPause enters event loop" -constraints knownBug -setup { +test http11-2.4.2.$ThreadLevel "-channel,encoding identity with -progress progressPause enters event loop" -constraints knownBug -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] set logdata "" @@ -540,7 +540,7 @@ test http11-2.4.2 "-channel,encoding identity with -progress progressPause enter unset -nocomplain logdata data ::WaitHere } -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0} -test http11-2.5 "-channel,encoding unsupported" -setup { +test http11-2.5.$ThreadLevel "-channel,encoding unsupported" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -560,7 +560,7 @@ test http11-2.5 "-channel,encoding unsupported" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} chunked} -test http11-2.6 "-channel,encoding gzip,non-chunked" -setup { +test http11-2.6.$ThreadLevel "-channel,encoding gzip,non-chunked" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -580,7 +580,7 @@ test http11-2.6 "-channel,encoding gzip,non-chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close gzip {} 0} -test http11-2.7 "-channel,encoding deflate,non-chunked" -setup { +test http11-2.7.$ThreadLevel "-channel,encoding deflate,non-chunked" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -600,7 +600,7 @@ test http11-2.7 "-channel,encoding deflate,non-chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0} -test http11-2.7.1 "-channel,encoding deflate,non-chunked,msdeflate" -constraints knownBug -setup { +test http11-2.7.1.$ThreadLevel "-channel,encoding deflate,non-chunked,msdeflate" -constraints knownBug -setup { # Test fails because a -channel can only try one un-deflate algorithm, and the # compliant "decompress" is tried, not the non-compliant "inflate" of # the MS browser implementation. @@ -623,7 +623,7 @@ test http11-2.7.1 "-channel,encoding deflate,non-chunked,msdeflate" -constraints halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0} -test http11-2.8 "-channel,encoding compress,non-chunked" -constraints badCompress -setup { +test http11-2.8.$ThreadLevel "-channel,encoding compress,non-chunked" -constraints badCompress -setup { # The Tcl "compress" algorithm appears to be incorrect and has been removed. # Bug [a13b9d0ce1]. variable httpd [create_httpd] @@ -645,7 +645,7 @@ test http11-2.8 "-channel,encoding compress,non-chunked" -constraints badCompres halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close compress {} 0} -test http11-2.9 "-channel,encoding identity,non-chunked" -setup { +test http11-2.9.$ThreadLevel "-channel,encoding identity,non-chunked" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -665,7 +665,7 @@ test http11-2.9 "-channel,encoding identity,non-chunked" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0} -test http11-2.10 "-channel,deflate,keepalive" -setup { +test http11-2.10.$ThreadLevel "-channel,deflate,keepalive" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -686,7 +686,7 @@ test http11-2.10 "-channel,deflate,keepalive" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0} -test http11-2.10.1 "-channel,deflate,keepalive,msdeflate" -setup { +test http11-2.10.1.$ThreadLevel "-channel,deflate,keepalive,msdeflate" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -707,7 +707,7 @@ test http11-2.10.1 "-channel,deflate,keepalive,msdeflate" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0} -test http11-2.11 "-channel,identity,keepalive" -setup { +test http11-2.11.$ThreadLevel "-channel,identity,keepalive" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -727,7 +727,7 @@ test http11-2.11 "-channel,identity,keepalive" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} {} chunked} -test http11-2.12 "-channel,negotiate,keepalive" -setup { +test http11-2.12.$ThreadLevel "-channel,negotiate,keepalive" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] } -body { @@ -775,7 +775,7 @@ proc handlerPause {var sock token} { return [string length $chunk] } -test http11-3.0 "-handler,close,identity" -setup { +test http11-3.0.$ThreadLevel "-handler,close,identity" -setup { variable httpd [create_httpd] set testdata "" } -body { @@ -792,7 +792,7 @@ test http11-3.0 "-handler,close,identity" -setup { halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} -test http11-3.1 "-handler,protocol1.0" -setup { +test http11-3.1.$ThreadLevel "-handler,protocol1.0" -setup { variable httpd [create_httpd] set testdata "" } -body { @@ -810,7 +810,7 @@ test http11-3.1 "-handler,protocol1.0" -setup { halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} -test http11-3.2 "-handler,close,chunked" -setup { +test http11-3.2.$ThreadLevel "-handler,close,chunked" -setup { variable httpd [create_httpd] set testdata "" } -body { @@ -828,7 +828,7 @@ test http11-3.2 "-handler,close,chunked" -setup { halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} -test http11-3.3 "-handler,keepalive,chunked" -setup { +test http11-3.3.$ThreadLevel "-handler,keepalive,chunked" -setup { variable httpd [create_httpd] set testdata "" } -body { @@ -856,7 +856,7 @@ test http11-3.3 "-handler,keepalive,chunked" -setup { # "Connection: keep-alive", i.e. the server will keep the connection # open. In HTTP/1.0 this is not the case, and this is a test that # the Tcl client assumes "Connection: close" by default in HTTP/1.0. -test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup { +test http11-3.4.$ThreadLevel "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup { variable httpd [create_httpd] set testdata "" } -body { @@ -874,7 +874,7 @@ test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connecti } -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0} # It is not forbidden for a handler to enter the event loop. -test http11-3.5 "-handler,close,identity as http11-3.0 but handlerPause enters event loop" -setup { +test http11-3.5.$ThreadLevel "-handler,close,identity as http11-3.0 but handlerPause enters event loop" -setup { variable httpd [create_httpd] set testdata "" } -body { @@ -891,7 +891,7 @@ test http11-3.5 "-handler,close,identity as http11-3.0 but handlerPause enters e halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} -test http11-3.6 "-handler,close,identity as http11-3.0 but with -progress" -setup { +test http11-3.6.$ThreadLevel "-handler,close,identity as http11-3.0 but with -progress" -setup { variable httpd [create_httpd] set testdata "" set logdata "" @@ -912,7 +912,7 @@ test http11-3.6 "-handler,close,identity as http11-3.0 but with -progress" -setu halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0} -test http11-3.7 "-handler,close,identity as http11-3.0 but with -progress progressPause enters event loop" -setup { +test http11-3.7.$ThreadLevel "-handler,close,identity as http11-3.0 but with -progress progressPause enters event loop" -setup { variable httpd [create_httpd] set testdata "" set logdata "" @@ -933,7 +933,7 @@ test http11-3.7 "-handler,close,identity as http11-3.0 but with -progress progre halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0} -test http11-3.8 "close,identity no -handler but with -progress" -setup { +test http11-3.8.$ThreadLevel "close,identity no -handler but with -progress" -setup { variable httpd [create_httpd] set logdata "" } -body { @@ -954,7 +954,7 @@ test http11-3.8 "close,identity no -handler but with -progress" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0} -test http11-3.9 "close,identity no -handler but with -progress progressPause enters event loop" -setup { +test http11-3.9.$ThreadLevel "close,identity no -handler but with -progress progressPause enters event loop" -setup { variable httpd [create_httpd] set logdata "" } -body { @@ -975,7 +975,7 @@ test http11-3.9 "close,identity no -handler but with -progress progressPause ent halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0} -test http11-4.0 "normal post request" -setup { +test http11-4.0.$ThreadLevel "normal post request" -setup { variable httpd [create_httpd] } -body { set query [http::formatQuery q 1 z 2] @@ -991,7 +991,7 @@ test http11-4.0 "normal post request" -setup { halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7} -test http11-4.1 "normal post request, check query length" -setup { +test http11-4.1.$ThreadLevel "normal post request, check query length" -setup { variable httpd [create_httpd] } -body { set query [http::formatQuery q 1 z 2] @@ -1008,7 +1008,7 @@ test http11-4.1 "normal post request, check query length" -setup { halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7} -test http11-4.2 "normal post request, check long query length" -setup { +test http11-4.2.$ThreadLevel "normal post request, check long query length" -setup { variable httpd [create_httpd] } -body { set query [string repeat a 24576] @@ -1025,7 +1025,7 @@ test http11-4.2 "normal post request, check long query length" -setup { halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 24576} -test http11-4.3 "normal post request, check channel query length" -setup { +test http11-4.3.$ThreadLevel "normal post request, check channel query length" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] puts -nonewline $chan [string repeat [encoding convertto utf-8 "This is a test\n"] 8192] diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test index 161519f..491aae0 100644 --- a/tests/httpPipeline.test +++ b/tests/httpPipeline.test @@ -839,7 +839,7 @@ for {set header 1} {$header <= 4} {incr header} { # Here's the test: - test httpPipeline-${header}.${footer}${label}-${tag} $name \ + test httpPipeline-${header}.${footer}${label}-${tag}-$ThreadLevel $name \ -constraints $cons \ -setup [string map [list TE $te] { # Restore default values for tests: diff --git a/tests/httpProxy.test b/tests/httpProxy.test new file mode 100644 index 0000000..d8bd6b7 --- /dev/null +++ b/tests/httpProxy.test @@ -0,0 +1,1146 @@ +# Commands covered: http::geturl when using a proxy server. +# +# This file contains a collection of tests for the http script library. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. +# +# Copyright © 1991-1993 The Regents of the University of California. +# Copyright © 1994-1996 Sun Microsystems, Inc. +# Copyright © 1998-2000 Ajuba Solutions. +# Copyright © 2022 Keith Nash. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.5 + namespace import -force ::tcltest::* +} + +package require http 2.10 + +proc bgerror {args} { + global errorInfo + puts stderr "httpProxy.test bgerror" + puts stderr [join $args] + puts stderr $errorInfo +} + +proc stopMe {token} { + set ${token}(z) done +} + +if {![info exists ThreadLevel]} { + if {[catch {package require Thread}] == 0} { + set ValueRange {0 1 2} + } else { + set ValueRange {0 1} + } + + # For each value of ThreadLevel, source this file recursively in the + # same interpreter. + foreach ThreadLevel $ValueRange { + source [info script] + } + catch {unset ThreadLevel} + catch {unset ValueRange} + return +} + +catch {puts "==== Test with ThreadLevel $ThreadLevel ===="} +http::config -threadlevel $ThreadLevel + + +#testConstraint needsSquid 1 +#testConstraint needsTls 1 + +if {[testConstraint needsTls]} { + package require tls + http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 \ + -tls1 0 -tls1.1 0 -tls1.2 1 -tls1.3 0 -autoservername 1] +} + +# Testing with Squid +# - Example Squid configuration for Enterprise Linux 8 (Red Hat, Oracle, Rocky, +# Alma, ...) is in file tests/httpProxySquidConfigForEL8.tar.gz. +# - Two instances of Squid are launched, one that needs authentication and one +# that does not. +# - Each instance of Squid listens on IPv4 and IPv6, on different ports. + +# Instance of Squid that does not need authentication. +set n4host 127.0.0.1 +set n6host ::1 +set n4port 3128 +set n6port 3130 + +# Instance of Squid that needs authentication. +set a4host 127.0.0.1 +set a6host ::1 +set a4port 3129 +set a6port 3131 + +# concat Basic [base64::encode alice:alicia] +set aliceCreds {Basic YWxpY2U6YWxpY2lh} + +# concat Basic [base64::encode intruder:intruder] +set badCreds {Basic aW50cnVkZXI6aW50cnVkZXI=} + +test httpProxy-1.1.$ThreadLevel {squid is running - ipv4 noauth} -constraints {needsSquid} -setup { +} -body { + set token [http::geturl http://$n4host:$n4port/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed]" +} -result {complete ok 400 -- none} -cleanup { + http::cleanup $token + unset -nocomplain token ri res +} + +test httpProxy-1.2.$ThreadLevel {squid is running - ipv6 noauth} -constraints {needsSquid} -setup { +} -body { + set token [http::geturl http://\[$n6host\]:$n6port/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed]" +} -result {complete ok 400 -- none} -cleanup { + http::cleanup $token + unset -nocomplain token ri res +} + +test httpProxy-1.3.$ThreadLevel {squid is running - ipv4 auth} -constraints {needsSquid} -setup { +} -body { + set token [http::geturl http://$a4host:$a4port/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed]" +} -result {complete ok 400 -- none} -cleanup { + http::cleanup $token + unset -nocomplain token ri res +} + +test httpProxy-1.4.$ThreadLevel {squid is running - ipv6 auth} -constraints {needsSquid} -setup { +} -body { + set token [http::geturl http://\[$a6host\]:$a6port/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed]" +} -result {complete ok 400 -- none} -cleanup { + http::cleanup $token + unset -nocomplain token ri res +} + +test httpProxy-2.1.$ThreadLevel {http no-proxy no-auth} -constraints {needsSquid} -setup { + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- none -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res +} + +test httpProxy-2.2.$ThreadLevel {https no-proxy no-auth} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- none -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res +} + +test httpProxy-2.3.$ThreadLevel {http with-proxy ipv4 no-auth} -constraints {needsSquid} -setup { + http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {} +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- HttpProxy -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res + http::config -proxyhost {} -proxyport {} -proxynot {} +} + +test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {} +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- SecureProxy -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res + http::config -proxyhost {} -proxyport {} -proxynot {} +} + +test httpProxy-2.5.$ThreadLevel {http with-proxy ipv6 no-auth} -constraints {needsSquid} -setup { + http::config -proxyhost $n6host -proxyport $n6port -proxynot {::1 localhost} -proxyauth {} +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- HttpProxy -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res + http::config -proxyhost {} -proxyport {} -proxynot {} +} + +test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost $n6host -proxyport $n6port -proxynot {::1 localhost} -proxyauth {} +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- SecureProxy -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res + http::config -proxyhost {} -proxyport {} -proxynot {} +} + +test httpProxy-3.1.$ThreadLevel {http no-proxy with-auth valid-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- none 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- none 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.3.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- HttpProxy 1 1 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- SecureProxy 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.5.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- HttpProxy 1 1 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- SecureProxy 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.7.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.7x.$ThreadLevel {http with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] + + http::config -proxyauth $aliceCreds +} -body { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.8.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] + + http::config -proxyauth $aliceCreds +} -body { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 0} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.9.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.9p.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds +} -body { + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] +after idle { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can +} + vwait ${token0}(z) + after cancel $can0 + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can0 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.9x.$ThreadLevel {http with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] + + http::config -proxyauth $aliceCreds +} -body { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.10.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.10p.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds +} -body { + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] +after idle { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token0; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can +} + vwait ${token0}(z) + after cancel $can0 + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can0 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] + + http::config -proxyauth $aliceCreds +} -body { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 0} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.1.$ThreadLevel {http no-proxy with-auth no-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- none 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- none 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.3.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 407 -- HttpProxy 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.5.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 407 -- HttpProxy 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.7.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.9.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.9p.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested and possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} +} -body { + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] +after idle { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token0; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can +} + vwait ${token0}(z) + after cancel $can0 + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can0 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.10.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-4.10p.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} +} -body { + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + +after idle { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can +} + vwait ${token0}(z) + after cancel $can0 + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $aliceCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can0 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.1.$ThreadLevel {http no-proxy with-auth bad-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- none 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 200 -- none 0 0 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.3.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 407 -- HttpProxy 1 1 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.5.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquid} -setup { + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds +} -body { + set token [http::geturl http://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 407 -- HttpProxy 1 1 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup { + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds +} -body { + set token [http::geturl https://www.google.com/] + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" +} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1} -cleanup { + http::cleanup $token + unset -nocomplain token ri res pos1 pos2 + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.7.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.7p.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested and possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds +} -body { + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + # Use the same caution as for the corresponding https test. +after idle { + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can +} + vwait ${token0}(z) + after cancel $can0 + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can0 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.8.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.8p.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds +} -body { + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. +after idle { + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can +} + vwait ${token0}(z) + after cancel $can0 + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can0 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.9.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds + set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # Use the same caution as for the corresponding https test. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +test httpProxy-5.10.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup { + array unset ::http::socketMapping + http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] +} -body { + # If a bug passes the socket of a failed CONNECT to the main request, an infinite + # wait can occur despite -timeout. Fix this with http::reset; to do this the call + # to http::geturl must be async so we have $token for use as argument of reset. + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] + set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] + vwait ${token}(z) + after cancel $can + + set ri [http::responseInfo $token] + set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] + set pos2 [lsearch -exact [set ${token}(requestHeaders)] $badCreds] + set same [string equal [set ${token0}(sock)] [set ${token}(sock)]] + set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ + [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ + [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" +} -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup { + http::cleanup $token0 + http::cleanup $token + unset -nocomplain token0 token ri res pos1 pos2 can same + array unset ::http::socketMapping + http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} +} + +# cleanup +unset -nocomplain n4host n6host n4port n6port a4host a6host a4port a6port aliceCreds badCreds + +rename bgerror {} +rename stopMe {} + +::tcltest::cleanupTests + +# Local variables: +# mode: tcl +# End: + diff --git a/tests/httpProxySquidConfigForEL8.tar.gz b/tests/httpProxySquidConfigForEL8.tar.gz Binary files differnew file mode 100644 index 0000000..a94dbdb --- /dev/null +++ b/tests/httpProxySquidConfigForEL8.tar.gz diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl index 55b52fd..9e0edcd 100644 --- a/tests/httpd11.tcl +++ b/tests/httpd11.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require tcl +package require Tcl proc ::tcl::dict::get? {dict key} { if {[dict exists $dict $key]} { @@ -150,7 +150,11 @@ proc Service {chan addr port} { if {[file exists $path] && [file isfile $path]} { foreach {what type} [mime-type $path] break set f [open $path r] - if {$what eq "binary"} {chan configure $f -translation binary} + if {$what eq "binary"} { + chan configure $f -translation binary + } else { + chan configure $f -encoding utf-8 + } set data [read $f] close $f set code "200 OK" diff --git a/tests/icuUcmTests.tcl b/tests/icuUcmTests.tcl new file mode 100644 index 0000000..3b70748 --- /dev/null +++ b/tests/icuUcmTests.tcl @@ -0,0 +1,1891 @@ + +# This file is automatically generated by ucm2tests.tcl. +# Edits will be overwritten on next generation. +# +# Generates tests comparing Tcl encodings to ICU. +# The generated file is NOT standalone. It should be sourced into a test script. + +proc ucmConvertfromMismatches {enc map} { + set mismatches {} + foreach {unihex hex} $map { + set unihex [string range 00000000$unihex end-7 end]; # Make 8 digits + set unich [subst "\\U$unihex"] + if {[encoding convertfrom -profile strict $enc [binary decode hex $hex]] ne $unich} { + lappend mismatches "<[printable $unich],$hex>" + } + } + return $mismatches +} +proc ucmConverttoMismatches {enc map} { + set mismatches {} + foreach {unihex hex} $map { + set unihex [string range 00000000$unihex end-7 end]; # Make 8 digits + set unich [subst "\\U$unihex"] + if {[encoding convertto -profile strict $enc $unich] ne [binary decode hex $hex]} { + lappend mismatches "<[printable $unich],$hex>" + } + } + return $mismatches +} +if {[info commands printable] eq ""} { + proc printable {s} { + set print "" + foreach c [split $s ""] { + set i [scan $c %c] + if {[string is print $c] && ($i <= 127)} { + append print $c + } elseif {$i <= 0xff} { + append print \\x[format %02X $i] + } elseif {$i <= 0xffff} { + append print \\u[format %04X $i] + } else { + append print \\U[format %08X $i] + } + } + return $print + } +} + + +# +# cp1250 (generated from glibc-CP1250-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1250 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1250 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A4 A4 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00BB BB 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C9 C9 00CB CB 00CD CD 00CE CE 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00DA DA 00DC DC 00DD DD 00DF DF 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E9 E9 00EB EB 00ED ED 00EE EE 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00FA FA 00FC FC 00FD FD 0102 C3 0103 E3 0104 A5 0105 B9 0106 C6 0107 E6 010C C8 010D E8 010E CF 010F EF 0110 D0 0111 F0 0118 CA 0119 EA 011A CC 011B EC 0139 C5 013A E5 013D BC 013E BE 0141 A3 0142 B3 0143 D1 0144 F1 0147 D2 0148 F2 0150 D5 0151 F5 0154 C0 0155 E0 0158 D8 0159 F8 015A 8C 015B 9C 015E AA 015F BA 0160 8A 0161 9A 0162 DE 0163 FE 0164 8D 0165 9D 016E D9 016F F9 0170 DB 0171 FB 0179 8F 017A 9F 017B AF 017C BF 017D 8E 017E 9E 02C7 A1 02D8 A2 02D9 FF 02DB B2 02DD BD 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1250 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1250 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A4 A4 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00BB BB 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C9 C9 00CB CB 00CD CD 00CE CE 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00DA DA 00DC DC 00DD DD 00DF DF 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E9 E9 00EB EB 00ED ED 00EE EE 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00FA FA 00FC FC 00FD FD 0102 C3 0103 E3 0104 A5 0105 B9 0106 C6 0107 E6 010C C8 010D E8 010E CF 010F EF 0110 D0 0111 F0 0118 CA 0119 EA 011A CC 011B EC 0139 C5 013A E5 013D BC 013E BE 0141 A3 0142 B3 0143 D1 0144 F1 0147 D2 0148 F2 0150 D5 0151 F5 0154 C0 0155 E0 0158 D8 0159 F8 015A 8C 015B 9C 015E AA 015F BA 0160 8A 0161 9A 0162 DE 0163 FE 0164 8D 0165 9D 016E D9 016F F9 0170 DB 0171 FB 0179 8F 017A 9F 017B AF 017C BF 017D 8E 017E 9E 02C7 A1 02D8 A2 02D9 FF 02DB B2 02DD BD 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +# cp1250 - invalid byte sequences +lappend encInvalidBytes {*}{ + cp1250 81 tcl8 \U00000081 -1 {} {} + cp1250 81 replace \uFFFD -1 {} {} + cp1250 81 strict {} 0 {} {} + cp1250 83 tcl8 \U00000083 -1 {} {} + cp1250 83 replace \uFFFD -1 {} {} + cp1250 83 strict {} 0 {} {} + cp1250 88 tcl8 \U00000088 -1 {} {} + cp1250 88 replace \uFFFD -1 {} {} + cp1250 88 strict {} 0 {} {} + cp1250 90 tcl8 \U00000090 -1 {} {} + cp1250 90 replace \uFFFD -1 {} {} + cp1250 90 strict {} 0 {} {} + cp1250 98 tcl8 \U00000098 -1 {} {} + cp1250 98 replace \uFFFD -1 {} {} + cp1250 98 strict {} 0 {} {} +}; # cp1250 + +# cp1250 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1250 \U00000080 tcl8 1A -1 {} {} + cp1250 \U00000080 replace 1A -1 {} {} + cp1250 \U00000080 strict {} 0 {} {} + cp1250 \U00000400 tcl8 1A -1 {} {} + cp1250 \U00000400 replace 1A -1 {} {} + cp1250 \U00000400 strict {} 0 {} {} + cp1250 \U0000D800 tcl8 1A -1 {} {} + cp1250 \U0000D800 replace 1A -1 {} {} + cp1250 \U0000D800 strict {} 0 {} {} + cp1250 \U0000DC00 tcl8 1A -1 {} {} + cp1250 \U0000DC00 replace 1A -1 {} {} + cp1250 \U0000DC00 strict {} 0 {} {} + cp1250 \U00010000 tcl8 1A -1 {} {} + cp1250 \U00010000 replace 1A -1 {} {} + cp1250 \U00010000 strict {} 0 {} {} + cp1250 \U0010FFFF tcl8 1A -1 {} {} + cp1250 \U0010FFFF replace 1A -1 {} {} + cp1250 \U0010FFFF strict {} 0 {} {} +}; # cp1250 + +# +# cp1251 (generated from glibc-CP1251-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1251 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1251 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A4 A4 00A6 A6 00A7 A7 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B5 B5 00B6 B6 00B7 B7 00BB BB 0401 A8 0402 80 0403 81 0404 AA 0405 BD 0406 B2 0407 AF 0408 A3 0409 8A 040A 8C 040B 8E 040C 8D 040E A1 040F 8F 0410 C0 0411 C1 0412 C2 0413 C3 0414 C4 0415 C5 0416 C6 0417 C7 0418 C8 0419 C9 041A CA 041B CB 041C CC 041D CD 041E CE 041F CF 0420 D0 0421 D1 0422 D2 0423 D3 0424 D4 0425 D5 0426 D6 0427 D7 0428 D8 0429 D9 042A DA 042B DB 042C DC 042D DD 042E DE 042F DF 0430 E0 0431 E1 0432 E2 0433 E3 0434 E4 0435 E5 0436 E6 0437 E7 0438 E8 0439 E9 043A EA 043B EB 043C EC 043D ED 043E EE 043F EF 0440 F0 0441 F1 0442 F2 0443 F3 0444 F4 0445 F5 0446 F6 0447 F7 0448 F8 0449 F9 044A FA 044B FB 044C FC 044D FD 044E FE 044F FF 0451 B8 0452 90 0453 83 0454 BA 0455 BE 0456 B3 0457 BF 0458 BC 0459 9A 045A 9C 045B 9E 045C 9D 045E A2 045F 9F 0490 A5 0491 B4 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 88 2116 B9 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1251 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1251 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A4 A4 00A6 A6 00A7 A7 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B5 B5 00B6 B6 00B7 B7 00BB BB 0401 A8 0402 80 0403 81 0404 AA 0405 BD 0406 B2 0407 AF 0408 A3 0409 8A 040A 8C 040B 8E 040C 8D 040E A1 040F 8F 0410 C0 0411 C1 0412 C2 0413 C3 0414 C4 0415 C5 0416 C6 0417 C7 0418 C8 0419 C9 041A CA 041B CB 041C CC 041D CD 041E CE 041F CF 0420 D0 0421 D1 0422 D2 0423 D3 0424 D4 0425 D5 0426 D6 0427 D7 0428 D8 0429 D9 042A DA 042B DB 042C DC 042D DD 042E DE 042F DF 0430 E0 0431 E1 0432 E2 0433 E3 0434 E4 0435 E5 0436 E6 0437 E7 0438 E8 0439 E9 043A EA 043B EB 043C EC 043D ED 043E EE 043F EF 0440 F0 0441 F1 0442 F2 0443 F3 0444 F4 0445 F5 0446 F6 0447 F7 0448 F8 0449 F9 044A FA 044B FB 044C FC 044D FD 044E FE 044F FF 0451 B8 0452 90 0453 83 0454 BA 0455 BE 0456 B3 0457 BF 0458 BC 0459 9A 045A 9C 045B 9E 045C 9D 045E A2 045F 9F 0490 A5 0491 B4 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 88 2116 B9 2122 99} +} -result {} + +# cp1251 - invalid byte sequences +lappend encInvalidBytes {*}{ + cp1251 98 tcl8 \U00000098 -1 {} {} + cp1251 98 replace \uFFFD -1 {} {} + cp1251 98 strict {} 0 {} {} +}; # cp1251 + +# cp1251 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1251 \U00000080 tcl8 1A -1 {} {} + cp1251 \U00000080 replace 1A -1 {} {} + cp1251 \U00000080 strict {} 0 {} {} + cp1251 \U00000400 tcl8 1A -1 {} {} + cp1251 \U00000400 replace 1A -1 {} {} + cp1251 \U00000400 strict {} 0 {} {} + cp1251 \U0000D800 tcl8 1A -1 {} {} + cp1251 \U0000D800 replace 1A -1 {} {} + cp1251 \U0000D800 strict {} 0 {} {} + cp1251 \U0000DC00 tcl8 1A -1 {} {} + cp1251 \U0000DC00 replace 1A -1 {} {} + cp1251 \U0000DC00 strict {} 0 {} {} + cp1251 \U00010000 tcl8 1A -1 {} {} + cp1251 \U00010000 replace 1A -1 {} {} + cp1251 \U00010000 strict {} 0 {} {} + cp1251 \U0010FFFF tcl8 1A -1 {} {} + cp1251 \U0010FFFF replace 1A -1 {} {} + cp1251 \U0010FFFF strict {} 0 {} {} +}; # cp1251 + +# +# cp1252 (generated from glibc-CP1252-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1252 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1252 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF 0152 8C 0153 9C 0160 8A 0161 9A 0178 9F 017D 8E 017E 9E 0192 83 02C6 88 02DC 98 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1252 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1252 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF 0152 8C 0153 9C 0160 8A 0161 9A 0178 9F 017D 8E 017E 9E 0192 83 02C6 88 02DC 98 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +# cp1252 - invalid byte sequences +lappend encInvalidBytes {*}{ + cp1252 81 tcl8 \U00000081 -1 {} {} + cp1252 81 replace \uFFFD -1 {} {} + cp1252 81 strict {} 0 {} {} + cp1252 8D tcl8 \U0000008D -1 {} {} + cp1252 8D replace \uFFFD -1 {} {} + cp1252 8D strict {} 0 {} {} + cp1252 8F tcl8 \U0000008F -1 {} {} + cp1252 8F replace \uFFFD -1 {} {} + cp1252 8F strict {} 0 {} {} + cp1252 90 tcl8 \U00000090 -1 {} {} + cp1252 90 replace \uFFFD -1 {} {} + cp1252 90 strict {} 0 {} {} + cp1252 9D tcl8 \U0000009D -1 {} {} + cp1252 9D replace \uFFFD -1 {} {} + cp1252 9D strict {} 0 {} {} +}; # cp1252 + +# cp1252 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1252 \U00000080 tcl8 1A -1 {} {} + cp1252 \U00000080 replace 1A -1 {} {} + cp1252 \U00000080 strict {} 0 {} {} + cp1252 \U00000400 tcl8 1A -1 {} {} + cp1252 \U00000400 replace 1A -1 {} {} + cp1252 \U00000400 strict {} 0 {} {} + cp1252 \U0000D800 tcl8 1A -1 {} {} + cp1252 \U0000D800 replace 1A -1 {} {} + cp1252 \U0000D800 strict {} 0 {} {} + cp1252 \U0000DC00 tcl8 1A -1 {} {} + cp1252 \U0000DC00 replace 1A -1 {} {} + cp1252 \U0000DC00 strict {} 0 {} {} + cp1252 \U00010000 tcl8 1A -1 {} {} + cp1252 \U00010000 replace 1A -1 {} {} + cp1252 \U00010000 strict {} 0 {} {} + cp1252 \U0010FFFF tcl8 1A -1 {} {} + cp1252 \U0010FFFF replace 1A -1 {} {} + cp1252 \U0010FFFF strict {} 0 {} {} +}; # cp1252 + +# +# cp1253 (generated from glibc-CP1253-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1253 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1253 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00BB BB 00BD BD 0192 83 0384 B4 0385 A1 0386 A2 0388 B8 0389 B9 038A BA 038C BC 038E BE 038F BF 0390 C0 0391 C1 0392 C2 0393 C3 0394 C4 0395 C5 0396 C6 0397 C7 0398 C8 0399 C9 039A CA 039B CB 039C CC 039D CD 039E CE 039F CF 03A0 D0 03A1 D1 03A3 D3 03A4 D4 03A5 D5 03A6 D6 03A7 D7 03A8 D8 03A9 D9 03AA DA 03AB DB 03AC DC 03AD DD 03AE DE 03AF DF 03B0 E0 03B1 E1 03B2 E2 03B3 E3 03B4 E4 03B5 E5 03B6 E6 03B7 E7 03B8 E8 03B9 E9 03BA EA 03BB EB 03BC EC 03BD ED 03BE EE 03BF EF 03C0 F0 03C1 F1 03C2 F2 03C3 F3 03C4 F4 03C5 F5 03C6 F6 03C7 F7 03C8 F8 03C9 F9 03CA FA 03CB FB 03CC FC 03CD FD 03CE FE 2013 96 2014 97 2015 AF 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1253 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1253 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00BB BB 00BD BD 0192 83 0384 B4 0385 A1 0386 A2 0388 B8 0389 B9 038A BA 038C BC 038E BE 038F BF 0390 C0 0391 C1 0392 C2 0393 C3 0394 C4 0395 C5 0396 C6 0397 C7 0398 C8 0399 C9 039A CA 039B CB 039C CC 039D CD 039E CE 039F CF 03A0 D0 03A1 D1 03A3 D3 03A4 D4 03A5 D5 03A6 D6 03A7 D7 03A8 D8 03A9 D9 03AA DA 03AB DB 03AC DC 03AD DD 03AE DE 03AF DF 03B0 E0 03B1 E1 03B2 E2 03B3 E3 03B4 E4 03B5 E5 03B6 E6 03B7 E7 03B8 E8 03B9 E9 03BA EA 03BB EB 03BC EC 03BD ED 03BE EE 03BF EF 03C0 F0 03C1 F1 03C2 F2 03C3 F3 03C4 F4 03C5 F5 03C6 F6 03C7 F7 03C8 F8 03C9 F9 03CA FA 03CB FB 03CC FC 03CD FD 03CE FE 2013 96 2014 97 2015 AF 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +# cp1253 - invalid byte sequences +lappend encInvalidBytes {*}{ + cp1253 81 tcl8 \U00000081 -1 {} {} + cp1253 81 replace \uFFFD -1 {} {} + cp1253 81 strict {} 0 {} {} + cp1253 88 tcl8 \U00000088 -1 {} {} + cp1253 88 replace \uFFFD -1 {} {} + cp1253 88 strict {} 0 {} {} + cp1253 8A tcl8 \U0000008A -1 {} {} + cp1253 8A replace \uFFFD -1 {} {} + cp1253 8A strict {} 0 {} {} + cp1253 8C tcl8 \U0000008C -1 {} {} + cp1253 8C replace \uFFFD -1 {} {} + cp1253 8C strict {} 0 {} {} + cp1253 8D tcl8 \U0000008D -1 {} {} + cp1253 8D replace \uFFFD -1 {} {} + cp1253 8D strict {} 0 {} {} + cp1253 8E tcl8 \U0000008E -1 {} {} + cp1253 8E replace \uFFFD -1 {} {} + cp1253 8E strict {} 0 {} {} + cp1253 8F tcl8 \U0000008F -1 {} {} + cp1253 8F replace \uFFFD -1 {} {} + cp1253 8F strict {} 0 {} {} + cp1253 90 tcl8 \U00000090 -1 {} {} + cp1253 90 replace \uFFFD -1 {} {} + cp1253 90 strict {} 0 {} {} + cp1253 98 tcl8 \U00000098 -1 {} {} + cp1253 98 replace \uFFFD -1 {} {} + cp1253 98 strict {} 0 {} {} + cp1253 9A tcl8 \U0000009A -1 {} {} + cp1253 9A replace \uFFFD -1 {} {} + cp1253 9A strict {} 0 {} {} + cp1253 9C tcl8 \U0000009C -1 {} {} + cp1253 9C replace \uFFFD -1 {} {} + cp1253 9C strict {} 0 {} {} + cp1253 9D tcl8 \U0000009D -1 {} {} + cp1253 9D replace \uFFFD -1 {} {} + cp1253 9D strict {} 0 {} {} + cp1253 9E tcl8 \U0000009E -1 {} {} + cp1253 9E replace \uFFFD -1 {} {} + cp1253 9E strict {} 0 {} {} + cp1253 9F tcl8 \U0000009F -1 {} {} + cp1253 9F replace \uFFFD -1 {} {} + cp1253 9F strict {} 0 {} {} + cp1253 AA tcl8 \U000000AA -1 {} {} + cp1253 AA replace \uFFFD -1 {} {} + cp1253 AA strict {} 0 {} {} + cp1253 D2 tcl8 \U000000D2 -1 {} {} + cp1253 D2 replace \uFFFD -1 {} {} + cp1253 D2 strict {} 0 {} {} + cp1253 FF tcl8 \U000000FF -1 {} {} + cp1253 FF replace \uFFFD -1 {} {} + cp1253 FF strict {} 0 {} {} +}; # cp1253 + +# cp1253 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1253 \U00000080 tcl8 1A -1 {} {} + cp1253 \U00000080 replace 1A -1 {} {} + cp1253 \U00000080 strict {} 0 {} {} + cp1253 \U00000400 tcl8 1A -1 {} {} + cp1253 \U00000400 replace 1A -1 {} {} + cp1253 \U00000400 strict {} 0 {} {} + cp1253 \U0000D800 tcl8 1A -1 {} {} + cp1253 \U0000D800 replace 1A -1 {} {} + cp1253 \U0000D800 strict {} 0 {} {} + cp1253 \U0000DC00 tcl8 1A -1 {} {} + cp1253 \U0000DC00 replace 1A -1 {} {} + cp1253 \U0000DC00 strict {} 0 {} {} + cp1253 \U00010000 tcl8 1A -1 {} {} + cp1253 \U00010000 replace 1A -1 {} {} + cp1253 \U00010000 strict {} 0 {} {} + cp1253 \U0010FFFF tcl8 1A -1 {} {} + cp1253 \U0010FFFF replace 1A -1 {} {} + cp1253 \U0010FFFF strict {} 0 {} {} +}; # cp1253 + +# +# cp1254 (generated from glibc-CP1254-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1254 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1254 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 011E D0 011F F0 0130 DD 0131 FD 0152 8C 0153 9C 015E DE 015F FE 0160 8A 0161 9A 0178 9F 0192 83 02C6 88 02DC 98 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1254 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1254 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 011E D0 011F F0 0130 DD 0131 FD 0152 8C 0153 9C 015E DE 015F FE 0160 8A 0161 9A 0178 9F 0192 83 02C6 88 02DC 98 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +# cp1254 - invalid byte sequences +lappend encInvalidBytes {*}{ + cp1254 81 tcl8 \U00000081 -1 {} {} + cp1254 81 replace \uFFFD -1 {} {} + cp1254 81 strict {} 0 {} {} + cp1254 8D tcl8 \U0000008D -1 {} {} + cp1254 8D replace \uFFFD -1 {} {} + cp1254 8D strict {} 0 {} {} + cp1254 8E tcl8 \U0000008E -1 {} {} + cp1254 8E replace \uFFFD -1 {} {} + cp1254 8E strict {} 0 {} {} + cp1254 8F tcl8 \U0000008F -1 {} {} + cp1254 8F replace \uFFFD -1 {} {} + cp1254 8F strict {} 0 {} {} + cp1254 90 tcl8 \U00000090 -1 {} {} + cp1254 90 replace \uFFFD -1 {} {} + cp1254 90 strict {} 0 {} {} + cp1254 9D tcl8 \U0000009D -1 {} {} + cp1254 9D replace \uFFFD -1 {} {} + cp1254 9D strict {} 0 {} {} + cp1254 9E tcl8 \U0000009E -1 {} {} + cp1254 9E replace \uFFFD -1 {} {} + cp1254 9E strict {} 0 {} {} +}; # cp1254 + +# cp1254 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1254 \U00000080 tcl8 1A -1 {} {} + cp1254 \U00000080 replace 1A -1 {} {} + cp1254 \U00000080 strict {} 0 {} {} + cp1254 \U00000400 tcl8 1A -1 {} {} + cp1254 \U00000400 replace 1A -1 {} {} + cp1254 \U00000400 strict {} 0 {} {} + cp1254 \U0000D800 tcl8 1A -1 {} {} + cp1254 \U0000D800 replace 1A -1 {} {} + cp1254 \U0000D800 strict {} 0 {} {} + cp1254 \U0000DC00 tcl8 1A -1 {} {} + cp1254 \U0000DC00 replace 1A -1 {} {} + cp1254 \U0000DC00 strict {} 0 {} {} + cp1254 \U00010000 tcl8 1A -1 {} {} + cp1254 \U00010000 replace 1A -1 {} {} + cp1254 \U00010000 strict {} 0 {} {} + cp1254 \U0010FFFF tcl8 1A -1 {} {} + cp1254 \U0010FFFF replace 1A -1 {} {} + cp1254 \U0010FFFF strict {} 0 {} {} +}; # cp1254 + +# +# cp1255 (generated from glibc-CP1255-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1255 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1255 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00D7 AA 00F7 BA 0192 83 02C6 88 02DC 98 05B0 C0 05B1 C1 05B2 C2 05B3 C3 05B4 C4 05B5 C5 05B6 C6 05B7 C7 05B8 C8 05B9 C9 05BB CB 05BC CC 05BD CD 05BE CE 05BF CF 05C0 D0 05C1 D1 05C2 D2 05C3 D3 05D0 E0 05D1 E1 05D2 E2 05D3 E3 05D4 E4 05D5 E5 05D6 E6 05D7 E7 05D8 E8 05D9 E9 05DA EA 05DB EB 05DC EC 05DD ED 05DE EE 05DF EF 05E0 F0 05E1 F1 05E2 F2 05E3 F3 05E4 F4 05E5 F5 05E6 F6 05E7 F7 05E8 F8 05E9 F9 05EA FA 05F0 D4 05F1 D5 05F2 D6 05F3 D7 05F4 D8 200E FD 200F FE 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AA A4 20AC 80 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1255 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1255 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00D7 AA 00F7 BA 0192 83 02C6 88 02DC 98 05B0 C0 05B1 C1 05B2 C2 05B3 C3 05B4 C4 05B5 C5 05B6 C6 05B7 C7 05B8 C8 05B9 C9 05BB CB 05BC CC 05BD CD 05BE CE 05BF CF 05C0 D0 05C1 D1 05C2 D2 05C3 D3 05D0 E0 05D1 E1 05D2 E2 05D3 E3 05D4 E4 05D5 E5 05D6 E6 05D7 E7 05D8 E8 05D9 E9 05DA EA 05DB EB 05DC EC 05DD ED 05DE EE 05DF EF 05E0 F0 05E1 F1 05E2 F2 05E3 F3 05E4 F4 05E5 F5 05E6 F6 05E7 F7 05E8 F8 05E9 F9 05EA FA 05F0 D4 05F1 D5 05F2 D6 05F3 D7 05F4 D8 200E FD 200F FE 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AA A4 20AC 80 2122 99} +} -result {} + +# cp1255 - invalid byte sequences +lappend encInvalidBytes {*}{ + cp1255 81 tcl8 \U00000081 -1 {} {} + cp1255 81 replace \uFFFD -1 {} {} + cp1255 81 strict {} 0 {} {} + cp1255 8A tcl8 \U0000008A -1 {} {} + cp1255 8A replace \uFFFD -1 {} {} + cp1255 8A strict {} 0 {} {} + cp1255 8C tcl8 \U0000008C -1 {} {} + cp1255 8C replace \uFFFD -1 {} {} + cp1255 8C strict {} 0 {} {} + cp1255 8D tcl8 \U0000008D -1 {} {} + cp1255 8D replace \uFFFD -1 {} {} + cp1255 8D strict {} 0 {} {} + cp1255 8E tcl8 \U0000008E -1 {} {} + cp1255 8E replace \uFFFD -1 {} {} + cp1255 8E strict {} 0 {} {} + cp1255 8F tcl8 \U0000008F -1 {} {} + cp1255 8F replace \uFFFD -1 {} {} + cp1255 8F strict {} 0 {} {} + cp1255 90 tcl8 \U00000090 -1 {} {} + cp1255 90 replace \uFFFD -1 {} {} + cp1255 90 strict {} 0 {} {} + cp1255 9A tcl8 \U0000009A -1 {} {} + cp1255 9A replace \uFFFD -1 {} {} + cp1255 9A strict {} 0 {} {} + cp1255 9C tcl8 \U0000009C -1 {} {} + cp1255 9C replace \uFFFD -1 {} {} + cp1255 9C strict {} 0 {} {} + cp1255 9D tcl8 \U0000009D -1 {} {} + cp1255 9D replace \uFFFD -1 {} {} + cp1255 9D strict {} 0 {} {} + cp1255 9E tcl8 \U0000009E -1 {} {} + cp1255 9E replace \uFFFD -1 {} {} + cp1255 9E strict {} 0 {} {} + cp1255 9F tcl8 \U0000009F -1 {} {} + cp1255 9F replace \uFFFD -1 {} {} + cp1255 9F strict {} 0 {} {} + cp1255 CA tcl8 \U000000CA -1 {} {} + cp1255 CA replace \uFFFD -1 {} {} + cp1255 CA strict {} 0 {} {} + cp1255 D9 tcl8 \U000000D9 -1 {} {} + cp1255 D9 replace \uFFFD -1 {} {} + cp1255 D9 strict {} 0 {} {} + cp1255 DA tcl8 \U000000DA -1 {} {} + cp1255 DA replace \uFFFD -1 {} {} + cp1255 DA strict {} 0 {} {} + cp1255 DB tcl8 \U000000DB -1 {} {} + cp1255 DB replace \uFFFD -1 {} {} + cp1255 DB strict {} 0 {} {} + cp1255 DC tcl8 \U000000DC -1 {} {} + cp1255 DC replace \uFFFD -1 {} {} + cp1255 DC strict {} 0 {} {} + cp1255 DD tcl8 \U000000DD -1 {} {} + cp1255 DD replace \uFFFD -1 {} {} + cp1255 DD strict {} 0 {} {} + cp1255 DE tcl8 \U000000DE -1 {} {} + cp1255 DE replace \uFFFD -1 {} {} + cp1255 DE strict {} 0 {} {} + cp1255 DF tcl8 \U000000DF -1 {} {} + cp1255 DF replace \uFFFD -1 {} {} + cp1255 DF strict {} 0 {} {} + cp1255 FB tcl8 \U000000FB -1 {} {} + cp1255 FB replace \uFFFD -1 {} {} + cp1255 FB strict {} 0 {} {} + cp1255 FC tcl8 \U000000FC -1 {} {} + cp1255 FC replace \uFFFD -1 {} {} + cp1255 FC strict {} 0 {} {} + cp1255 FF tcl8 \U000000FF -1 {} {} + cp1255 FF replace \uFFFD -1 {} {} + cp1255 FF strict {} 0 {} {} +}; # cp1255 + +# cp1255 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1255 \U00000080 tcl8 1A -1 {} {} + cp1255 \U00000080 replace 1A -1 {} {} + cp1255 \U00000080 strict {} 0 {} {} + cp1255 \U00000400 tcl8 1A -1 {} {} + cp1255 \U00000400 replace 1A -1 {} {} + cp1255 \U00000400 strict {} 0 {} {} + cp1255 \U0000D800 tcl8 1A -1 {} {} + cp1255 \U0000D800 replace 1A -1 {} {} + cp1255 \U0000D800 strict {} 0 {} {} + cp1255 \U0000DC00 tcl8 1A -1 {} {} + cp1255 \U0000DC00 replace 1A -1 {} {} + cp1255 \U0000DC00 strict {} 0 {} {} + cp1255 \U00010000 tcl8 1A -1 {} {} + cp1255 \U00010000 replace 1A -1 {} {} + cp1255 \U00010000 strict {} 0 {} {} + cp1255 \U0010FFFF tcl8 1A -1 {} {} + cp1255 \U0010FFFF replace 1A -1 {} {} + cp1255 \U0010FFFF strict {} 0 {} {} +}; # cp1255 + +# +# cp1256 (generated from glibc-CP1256-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1256 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1256 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00D7 D7 00E0 E0 00E2 E2 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EE EE 00EF EF 00F4 F4 00F7 F7 00F9 F9 00FB FB 00FC FC 0152 8C 0153 9C 0192 83 02C6 88 060C A1 061B BA 061F BF 0621 C1 0622 C2 0623 C3 0624 C4 0625 C5 0626 C6 0627 C7 0628 C8 0629 C9 062A CA 062B CB 062C CC 062D CD 062E CE 062F CF 0630 D0 0631 D1 0632 D2 0633 D3 0634 D4 0635 D5 0636 D6 0637 D8 0638 D9 0639 DA 063A DB 0640 DC 0641 DD 0642 DE 0643 DF 0644 E1 0645 E3 0646 E4 0647 E5 0648 E6 0649 EC 064A ED 064B F0 064C F1 064D F2 064E F3 064F F5 0650 F6 0651 F8 0652 FA 0679 8A 067E 81 0686 8D 0688 8F 0691 9A 0698 8E 06A9 98 06AF 90 06BA 9F 06BE AA 06C1 C0 06D2 FF 200C 9D 200D 9E 200E FD 200F FE 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1256 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1256 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00D7 D7 00E0 E0 00E2 E2 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EE EE 00EF EF 00F4 F4 00F7 F7 00F9 F9 00FB FB 00FC FC 0152 8C 0153 9C 0192 83 02C6 88 060C A1 061B BA 061F BF 0621 C1 0622 C2 0623 C3 0624 C4 0625 C5 0626 C6 0627 C7 0628 C8 0629 C9 062A CA 062B CB 062C CC 062D CD 062E CE 062F CF 0630 D0 0631 D1 0632 D2 0633 D3 0634 D4 0635 D5 0636 D6 0637 D8 0638 D9 0639 DA 063A DB 0640 DC 0641 DD 0642 DE 0643 DF 0644 E1 0645 E3 0646 E4 0647 E5 0648 E6 0649 EC 064A ED 064B F0 064C F1 064D F2 064E F3 064F F5 0650 F6 0651 F8 0652 FA 0679 8A 067E 81 0686 8D 0688 8F 0691 9A 0698 8E 06A9 98 06AF 90 06BA 9F 06BE AA 06C1 C0 06D2 FF 200C 9D 200D 9E 200E FD 200F FE 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +# cp1256 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # cp1256 + +# cp1256 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1256 \U00000080 tcl8 1A -1 {} {} + cp1256 \U00000080 replace 1A -1 {} {} + cp1256 \U00000080 strict {} 0 {} {} + cp1256 \U00000400 tcl8 1A -1 {} {} + cp1256 \U00000400 replace 1A -1 {} {} + cp1256 \U00000400 strict {} 0 {} {} + cp1256 \U0000D800 tcl8 1A -1 {} {} + cp1256 \U0000D800 replace 1A -1 {} {} + cp1256 \U0000D800 strict {} 0 {} {} + cp1256 \U0000DC00 tcl8 1A -1 {} {} + cp1256 \U0000DC00 replace 1A -1 {} {} + cp1256 \U0000DC00 strict {} 0 {} {} + cp1256 \U00010000 tcl8 1A -1 {} {} + cp1256 \U00010000 replace 1A -1 {} {} + cp1256 \U00010000 strict {} 0 {} {} + cp1256 \U0010FFFF tcl8 1A -1 {} {} + cp1256 \U0010FFFF replace 1A -1 {} {} + cp1256 \U0010FFFF strict {} 0 {} {} +}; # cp1256 + +# +# cp1257 (generated from glibc-CP1257-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1257 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1257 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A6 A6 00A7 A7 00A8 8D 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF 9D 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 8F 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00C4 C4 00C5 C5 00C6 AF 00C9 C9 00D3 D3 00D5 D5 00D6 D6 00D7 D7 00D8 A8 00DC DC 00DF DF 00E4 E4 00E5 E5 00E6 BF 00E9 E9 00F3 F3 00F5 F5 00F6 F6 00F7 F7 00F8 B8 00FC FC 0100 C2 0101 E2 0104 C0 0105 E0 0106 C3 0107 E3 010C C8 010D E8 0112 C7 0113 E7 0116 CB 0117 EB 0118 C6 0119 E6 0122 CC 0123 EC 012A CE 012B EE 012E C1 012F E1 0136 CD 0137 ED 013B CF 013C EF 0141 D9 0142 F9 0143 D1 0144 F1 0145 D2 0146 F2 014C D4 014D F4 0156 AA 0157 BA 015A DA 015B FA 0160 D0 0161 F0 016A DB 016B FB 0172 D8 0173 F8 0179 CA 017A EA 017B DD 017C FD 017D DE 017E FE 02C7 8E 02D9 FF 02DB 9E 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1257 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1257 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A6 A6 00A7 A7 00A8 8D 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF 9D 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 8F 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00C4 C4 00C5 C5 00C6 AF 00C9 C9 00D3 D3 00D5 D5 00D6 D6 00D7 D7 00D8 A8 00DC DC 00DF DF 00E4 E4 00E5 E5 00E6 BF 00E9 E9 00F3 F3 00F5 F5 00F6 F6 00F7 F7 00F8 B8 00FC FC 0100 C2 0101 E2 0104 C0 0105 E0 0106 C3 0107 E3 010C C8 010D E8 0112 C7 0113 E7 0116 CB 0117 EB 0118 C6 0119 E6 0122 CC 0123 EC 012A CE 012B EE 012E C1 012F E1 0136 CD 0137 ED 013B CF 013C EF 0141 D9 0142 F9 0143 D1 0144 F1 0145 D2 0146 F2 014C D4 014D F4 0156 AA 0157 BA 015A DA 015B FA 0160 D0 0161 F0 016A DB 016B FB 0172 D8 0173 F8 0179 CA 017A EA 017B DD 017C FD 017D DE 017E FE 02C7 8E 02D9 FF 02DB 9E 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AC 80 2122 99} +} -result {} + +# cp1257 - invalid byte sequences +lappend encInvalidBytes {*}{ + cp1257 81 tcl8 \U00000081 -1 {} {} + cp1257 81 replace \uFFFD -1 {} {} + cp1257 81 strict {} 0 {} {} + cp1257 83 tcl8 \U00000083 -1 {} {} + cp1257 83 replace \uFFFD -1 {} {} + cp1257 83 strict {} 0 {} {} + cp1257 88 tcl8 \U00000088 -1 {} {} + cp1257 88 replace \uFFFD -1 {} {} + cp1257 88 strict {} 0 {} {} + cp1257 8A tcl8 \U0000008A -1 {} {} + cp1257 8A replace \uFFFD -1 {} {} + cp1257 8A strict {} 0 {} {} + cp1257 8C tcl8 \U0000008C -1 {} {} + cp1257 8C replace \uFFFD -1 {} {} + cp1257 8C strict {} 0 {} {} + cp1257 90 tcl8 \U00000090 -1 {} {} + cp1257 90 replace \uFFFD -1 {} {} + cp1257 90 strict {} 0 {} {} + cp1257 98 tcl8 \U00000098 -1 {} {} + cp1257 98 replace \uFFFD -1 {} {} + cp1257 98 strict {} 0 {} {} + cp1257 9A tcl8 \U0000009A -1 {} {} + cp1257 9A replace \uFFFD -1 {} {} + cp1257 9A strict {} 0 {} {} + cp1257 9C tcl8 \U0000009C -1 {} {} + cp1257 9C replace \uFFFD -1 {} {} + cp1257 9C strict {} 0 {} {} + cp1257 9F tcl8 \U0000009F -1 {} {} + cp1257 9F replace \uFFFD -1 {} {} + cp1257 9F strict {} 0 {} {} + cp1257 A1 tcl8 \U000000A1 -1 {} {} + cp1257 A1 replace \uFFFD -1 {} {} + cp1257 A1 strict {} 0 {} {} + cp1257 A5 tcl8 \U000000A5 -1 {} {} + cp1257 A5 replace \uFFFD -1 {} {} + cp1257 A5 strict {} 0 {} {} +}; # cp1257 + +# cp1257 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1257 \U00000080 tcl8 1A -1 {} {} + cp1257 \U00000080 replace 1A -1 {} {} + cp1257 \U00000080 strict {} 0 {} {} + cp1257 \U00000400 tcl8 1A -1 {} {} + cp1257 \U00000400 replace 1A -1 {} {} + cp1257 \U00000400 strict {} 0 {} {} + cp1257 \U0000D800 tcl8 1A -1 {} {} + cp1257 \U0000D800 replace 1A -1 {} {} + cp1257 \U0000D800 strict {} 0 {} {} + cp1257 \U0000DC00 tcl8 1A -1 {} {} + cp1257 \U0000DC00 replace 1A -1 {} {} + cp1257 \U0000DC00 strict {} 0 {} {} + cp1257 \U00010000 tcl8 1A -1 {} {} + cp1257 \U00010000 replace 1A -1 {} {} + cp1257 \U00010000 strict {} 0 {} {} + cp1257 \U0010FFFF tcl8 1A -1 {} {} + cp1257 \U0010FFFF replace 1A -1 {} {} + cp1257 \U0010FFFF strict {} 0 {} {} +}; # cp1257 + +# +# cp1258 (generated from glibc-CP1258-2.1.2) + +test encoding-convertfrom-ucmCompare-cp1258 {Compare against ICU UCM} -body { + ucmConvertfromMismatches cp1258 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CD CD 00CE CE 00CF CF 00D1 D1 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00ED ED 00EE EE 00EF EF 00F1 F1 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 0102 C3 0103 E3 0110 D0 0111 F0 0152 8C 0153 9C 0178 9F 0192 83 01A0 D5 01A1 F5 01AF DD 01B0 FD 02C6 88 02DC 98 0300 CC 0303 DE 0309 D2 0323 F2 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AB FE 20AC 80 2122 99} +} -result {} + +test encoding-convertto-ucmCompare-cp1258 {Compare against ICU UCM} -body { + ucmConverttoMismatches cp1258 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CD CD 00CE CE 00CF CF 00D1 D1 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00ED ED 00EE EE 00EF EF 00F1 F1 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 0102 C3 0103 E3 0110 D0 0111 F0 0152 8C 0153 9C 0178 9F 0192 83 01A0 D5 01A1 F5 01AF DD 01B0 FD 02C6 88 02DC 98 0300 CC 0303 DE 0309 D2 0323 F2 2013 96 2014 97 2018 91 2019 92 201A 82 201C 93 201D 94 201E 84 2020 86 2021 87 2022 95 2026 85 2030 89 2039 8B 203A 9B 20AB FE 20AC 80 2122 99} +} -result {} + +# cp1258 - invalid byte sequences +lappend encInvalidBytes {*}{ + cp1258 81 tcl8 \U00000081 -1 {} {} + cp1258 81 replace \uFFFD -1 {} {} + cp1258 81 strict {} 0 {} {} + cp1258 8A tcl8 \U0000008A -1 {} {} + cp1258 8A replace \uFFFD -1 {} {} + cp1258 8A strict {} 0 {} {} + cp1258 8D tcl8 \U0000008D -1 {} {} + cp1258 8D replace \uFFFD -1 {} {} + cp1258 8D strict {} 0 {} {} + cp1258 8E tcl8 \U0000008E -1 {} {} + cp1258 8E replace \uFFFD -1 {} {} + cp1258 8E strict {} 0 {} {} + cp1258 8F tcl8 \U0000008F -1 {} {} + cp1258 8F replace \uFFFD -1 {} {} + cp1258 8F strict {} 0 {} {} + cp1258 90 tcl8 \U00000090 -1 {} {} + cp1258 90 replace \uFFFD -1 {} {} + cp1258 90 strict {} 0 {} {} + cp1258 9A tcl8 \U0000009A -1 {} {} + cp1258 9A replace \uFFFD -1 {} {} + cp1258 9A strict {} 0 {} {} + cp1258 9D tcl8 \U0000009D -1 {} {} + cp1258 9D replace \uFFFD -1 {} {} + cp1258 9D strict {} 0 {} {} + cp1258 9E tcl8 \U0000009E -1 {} {} + cp1258 9E replace \uFFFD -1 {} {} + cp1258 9E strict {} 0 {} {} + cp1258 EC tcl8 \U000000EC -1 {} {} + cp1258 EC replace \uFFFD -1 {} {} + cp1258 EC strict {} 0 {} {} +}; # cp1258 + +# cp1258 - invalid byte sequences +lappend encUnencodableStrings {*}{ + cp1258 \U00000080 tcl8 1A -1 {} {} + cp1258 \U00000080 replace 1A -1 {} {} + cp1258 \U00000080 strict {} 0 {} {} + cp1258 \U00000400 tcl8 1A -1 {} {} + cp1258 \U00000400 replace 1A -1 {} {} + cp1258 \U00000400 strict {} 0 {} {} + cp1258 \U0000D800 tcl8 1A -1 {} {} + cp1258 \U0000D800 replace 1A -1 {} {} + cp1258 \U0000D800 strict {} 0 {} {} + cp1258 \U0000DC00 tcl8 1A -1 {} {} + cp1258 \U0000DC00 replace 1A -1 {} {} + cp1258 \U0000DC00 strict {} 0 {} {} + cp1258 \U00010000 tcl8 1A -1 {} {} + cp1258 \U00010000 replace 1A -1 {} {} + cp1258 \U00010000 strict {} 0 {} {} + cp1258 \U0010FFFF tcl8 1A -1 {} {} + cp1258 \U0010FFFF replace 1A -1 {} {} + cp1258 \U0010FFFF strict {} 0 {} {} +}; # cp1258 + +# +# gb1988 (generated from glibc-GB_1988_80-2.3.3) + +test encoding-convertfrom-ucmCompare-gb1988 {Compare against ICU UCM} -body { + ucmConvertfromMismatches gb1988 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007F 7F 00A5 24 203E 7E} +} -result {} + +test encoding-convertto-ucmCompare-gb1988 {Compare against ICU UCM} -body { + ucmConverttoMismatches gb1988 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007F 7F 00A5 24 203E 7E} +} -result {} + +# gb1988 - invalid byte sequences +lappend encInvalidBytes {*}{ + gb1988 80 tcl8 \U00000080 -1 {} {} + gb1988 80 replace \uFFFD -1 {} {} + gb1988 80 strict {} 0 {} {} + gb1988 81 tcl8 \U00000081 -1 {} {} + gb1988 81 replace \uFFFD -1 {} {} + gb1988 81 strict {} 0 {} {} + gb1988 82 tcl8 \U00000082 -1 {} {} + gb1988 82 replace \uFFFD -1 {} {} + gb1988 82 strict {} 0 {} {} + gb1988 83 tcl8 \U00000083 -1 {} {} + gb1988 83 replace \uFFFD -1 {} {} + gb1988 83 strict {} 0 {} {} + gb1988 84 tcl8 \U00000084 -1 {} {} + gb1988 84 replace \uFFFD -1 {} {} + gb1988 84 strict {} 0 {} {} + gb1988 85 tcl8 \U00000085 -1 {} {} + gb1988 85 replace \uFFFD -1 {} {} + gb1988 85 strict {} 0 {} {} + gb1988 86 tcl8 \U00000086 -1 {} {} + gb1988 86 replace \uFFFD -1 {} {} + gb1988 86 strict {} 0 {} {} + gb1988 87 tcl8 \U00000087 -1 {} {} + gb1988 87 replace \uFFFD -1 {} {} + gb1988 87 strict {} 0 {} {} + gb1988 88 tcl8 \U00000088 -1 {} {} + gb1988 88 replace \uFFFD -1 {} {} + gb1988 88 strict {} 0 {} {} + gb1988 89 tcl8 \U00000089 -1 {} {} + gb1988 89 replace \uFFFD -1 {} {} + gb1988 89 strict {} 0 {} {} + gb1988 8A tcl8 \U0000008A -1 {} {} + gb1988 8A replace \uFFFD -1 {} {} + gb1988 8A strict {} 0 {} {} + gb1988 8B tcl8 \U0000008B -1 {} {} + gb1988 8B replace \uFFFD -1 {} {} + gb1988 8B strict {} 0 {} {} + gb1988 8C tcl8 \U0000008C -1 {} {} + gb1988 8C replace \uFFFD -1 {} {} + gb1988 8C strict {} 0 {} {} + gb1988 8D tcl8 \U0000008D -1 {} {} + gb1988 8D replace \uFFFD -1 {} {} + gb1988 8D strict {} 0 {} {} + gb1988 8E tcl8 \U0000008E -1 {} {} + gb1988 8E replace \uFFFD -1 {} {} + gb1988 8E strict {} 0 {} {} + gb1988 8F tcl8 \U0000008F -1 {} {} + gb1988 8F replace \uFFFD -1 {} {} + gb1988 8F strict {} 0 {} {} + gb1988 90 tcl8 \U00000090 -1 {} {} + gb1988 90 replace \uFFFD -1 {} {} + gb1988 90 strict {} 0 {} {} + gb1988 91 tcl8 \U00000091 -1 {} {} + gb1988 91 replace \uFFFD -1 {} {} + gb1988 91 strict {} 0 {} {} + gb1988 92 tcl8 \U00000092 -1 {} {} + gb1988 92 replace \uFFFD -1 {} {} + gb1988 92 strict {} 0 {} {} + gb1988 93 tcl8 \U00000093 -1 {} {} + gb1988 93 replace \uFFFD -1 {} {} + gb1988 93 strict {} 0 {} {} + gb1988 94 tcl8 \U00000094 -1 {} {} + gb1988 94 replace \uFFFD -1 {} {} + gb1988 94 strict {} 0 {} {} + gb1988 95 tcl8 \U00000095 -1 {} {} + gb1988 95 replace \uFFFD -1 {} {} + gb1988 95 strict {} 0 {} {} + gb1988 96 tcl8 \U00000096 -1 {} {} + gb1988 96 replace \uFFFD -1 {} {} + gb1988 96 strict {} 0 {} {} + gb1988 97 tcl8 \U00000097 -1 {} {} + gb1988 97 replace \uFFFD -1 {} {} + gb1988 97 strict {} 0 {} {} + gb1988 98 tcl8 \U00000098 -1 {} {} + gb1988 98 replace \uFFFD -1 {} {} + gb1988 98 strict {} 0 {} {} + gb1988 99 tcl8 \U00000099 -1 {} {} + gb1988 99 replace \uFFFD -1 {} {} + gb1988 99 strict {} 0 {} {} + gb1988 9A tcl8 \U0000009A -1 {} {} + gb1988 9A replace \uFFFD -1 {} {} + gb1988 9A strict {} 0 {} {} + gb1988 9B tcl8 \U0000009B -1 {} {} + gb1988 9B replace \uFFFD -1 {} {} + gb1988 9B strict {} 0 {} {} + gb1988 9C tcl8 \U0000009C -1 {} {} + gb1988 9C replace \uFFFD -1 {} {} + gb1988 9C strict {} 0 {} {} + gb1988 9D tcl8 \U0000009D -1 {} {} + gb1988 9D replace \uFFFD -1 {} {} + gb1988 9D strict {} 0 {} {} + gb1988 9E tcl8 \U0000009E -1 {} {} + gb1988 9E replace \uFFFD -1 {} {} + gb1988 9E strict {} 0 {} {} + gb1988 9F tcl8 \U0000009F -1 {} {} + gb1988 9F replace \uFFFD -1 {} {} + gb1988 9F strict {} 0 {} {} + gb1988 A0 tcl8 \U000000A0 -1 {} {} + gb1988 A0 replace \uFFFD -1 {} {} + gb1988 A0 strict {} 0 {} {} + gb1988 A1 tcl8 \U000000A1 -1 {} {} + gb1988 A1 replace \uFFFD -1 {} {} + gb1988 A1 strict {} 0 {} {} + gb1988 A2 tcl8 \U000000A2 -1 {} {} + gb1988 A2 replace \uFFFD -1 {} {} + gb1988 A2 strict {} 0 {} {} + gb1988 A3 tcl8 \U000000A3 -1 {} {} + gb1988 A3 replace \uFFFD -1 {} {} + gb1988 A3 strict {} 0 {} {} + gb1988 A4 tcl8 \U000000A4 -1 {} {} + gb1988 A4 replace \uFFFD -1 {} {} + gb1988 A4 strict {} 0 {} {} + gb1988 A5 tcl8 \U000000A5 -1 {} {} + gb1988 A5 replace \uFFFD -1 {} {} + gb1988 A5 strict {} 0 {} {} + gb1988 A6 tcl8 \U000000A6 -1 {} {} + gb1988 A6 replace \uFFFD -1 {} {} + gb1988 A6 strict {} 0 {} {} + gb1988 A7 tcl8 \U000000A7 -1 {} {} + gb1988 A7 replace \uFFFD -1 {} {} + gb1988 A7 strict {} 0 {} {} + gb1988 A8 tcl8 \U000000A8 -1 {} {} + gb1988 A8 replace \uFFFD -1 {} {} + gb1988 A8 strict {} 0 {} {} + gb1988 A9 tcl8 \U000000A9 -1 {} {} + gb1988 A9 replace \uFFFD -1 {} {} + gb1988 A9 strict {} 0 {} {} + gb1988 AA tcl8 \U000000AA -1 {} {} + gb1988 AA replace \uFFFD -1 {} {} + gb1988 AA strict {} 0 {} {} + gb1988 AB tcl8 \U000000AB -1 {} {} + gb1988 AB replace \uFFFD -1 {} {} + gb1988 AB strict {} 0 {} {} + gb1988 AC tcl8 \U000000AC -1 {} {} + gb1988 AC replace \uFFFD -1 {} {} + gb1988 AC strict {} 0 {} {} + gb1988 AD tcl8 \U000000AD -1 {} {} + gb1988 AD replace \uFFFD -1 {} {} + gb1988 AD strict {} 0 {} {} + gb1988 AE tcl8 \U000000AE -1 {} {} + gb1988 AE replace \uFFFD -1 {} {} + gb1988 AE strict {} 0 {} {} + gb1988 AF tcl8 \U000000AF -1 {} {} + gb1988 AF replace \uFFFD -1 {} {} + gb1988 AF strict {} 0 {} {} + gb1988 B0 tcl8 \U000000B0 -1 {} {} + gb1988 B0 replace \uFFFD -1 {} {} + gb1988 B0 strict {} 0 {} {} + gb1988 B1 tcl8 \U000000B1 -1 {} {} + gb1988 B1 replace \uFFFD -1 {} {} + gb1988 B1 strict {} 0 {} {} + gb1988 B2 tcl8 \U000000B2 -1 {} {} + gb1988 B2 replace \uFFFD -1 {} {} + gb1988 B2 strict {} 0 {} {} + gb1988 B3 tcl8 \U000000B3 -1 {} {} + gb1988 B3 replace \uFFFD -1 {} {} + gb1988 B3 strict {} 0 {} {} + gb1988 B4 tcl8 \U000000B4 -1 {} {} + gb1988 B4 replace \uFFFD -1 {} {} + gb1988 B4 strict {} 0 {} {} + gb1988 B5 tcl8 \U000000B5 -1 {} {} + gb1988 B5 replace \uFFFD -1 {} {} + gb1988 B5 strict {} 0 {} {} + gb1988 B6 tcl8 \U000000B6 -1 {} {} + gb1988 B6 replace \uFFFD -1 {} {} + gb1988 B6 strict {} 0 {} {} + gb1988 B7 tcl8 \U000000B7 -1 {} {} + gb1988 B7 replace \uFFFD -1 {} {} + gb1988 B7 strict {} 0 {} {} + gb1988 B8 tcl8 \U000000B8 -1 {} {} + gb1988 B8 replace \uFFFD -1 {} {} + gb1988 B8 strict {} 0 {} {} + gb1988 B9 tcl8 \U000000B9 -1 {} {} + gb1988 B9 replace \uFFFD -1 {} {} + gb1988 B9 strict {} 0 {} {} + gb1988 BA tcl8 \U000000BA -1 {} {} + gb1988 BA replace \uFFFD -1 {} {} + gb1988 BA strict {} 0 {} {} + gb1988 BB tcl8 \U000000BB -1 {} {} + gb1988 BB replace \uFFFD -1 {} {} + gb1988 BB strict {} 0 {} {} + gb1988 BC tcl8 \U000000BC -1 {} {} + gb1988 BC replace \uFFFD -1 {} {} + gb1988 BC strict {} 0 {} {} + gb1988 BD tcl8 \U000000BD -1 {} {} + gb1988 BD replace \uFFFD -1 {} {} + gb1988 BD strict {} 0 {} {} + gb1988 BE tcl8 \U000000BE -1 {} {} + gb1988 BE replace \uFFFD -1 {} {} + gb1988 BE strict {} 0 {} {} + gb1988 BF tcl8 \U000000BF -1 {} {} + gb1988 BF replace \uFFFD -1 {} {} + gb1988 BF strict {} 0 {} {} + gb1988 C0 tcl8 \U000000C0 -1 {} {} + gb1988 C0 replace \uFFFD -1 {} {} + gb1988 C0 strict {} 0 {} {} + gb1988 C1 tcl8 \U000000C1 -1 {} {} + gb1988 C1 replace \uFFFD -1 {} {} + gb1988 C1 strict {} 0 {} {} + gb1988 C2 tcl8 \U000000C2 -1 {} {} + gb1988 C2 replace \uFFFD -1 {} {} + gb1988 C2 strict {} 0 {} {} + gb1988 C3 tcl8 \U000000C3 -1 {} {} + gb1988 C3 replace \uFFFD -1 {} {} + gb1988 C3 strict {} 0 {} {} + gb1988 C4 tcl8 \U000000C4 -1 {} {} + gb1988 C4 replace \uFFFD -1 {} {} + gb1988 C4 strict {} 0 {} {} + gb1988 C5 tcl8 \U000000C5 -1 {} {} + gb1988 C5 replace \uFFFD -1 {} {} + gb1988 C5 strict {} 0 {} {} + gb1988 C6 tcl8 \U000000C6 -1 {} {} + gb1988 C6 replace \uFFFD -1 {} {} + gb1988 C6 strict {} 0 {} {} + gb1988 C7 tcl8 \U000000C7 -1 {} {} + gb1988 C7 replace \uFFFD -1 {} {} + gb1988 C7 strict {} 0 {} {} + gb1988 C8 tcl8 \U000000C8 -1 {} {} + gb1988 C8 replace \uFFFD -1 {} {} + gb1988 C8 strict {} 0 {} {} + gb1988 C9 tcl8 \U000000C9 -1 {} {} + gb1988 C9 replace \uFFFD -1 {} {} + gb1988 C9 strict {} 0 {} {} + gb1988 CA tcl8 \U000000CA -1 {} {} + gb1988 CA replace \uFFFD -1 {} {} + gb1988 CA strict {} 0 {} {} + gb1988 CB tcl8 \U000000CB -1 {} {} + gb1988 CB replace \uFFFD -1 {} {} + gb1988 CB strict {} 0 {} {} + gb1988 CC tcl8 \U000000CC -1 {} {} + gb1988 CC replace \uFFFD -1 {} {} + gb1988 CC strict {} 0 {} {} + gb1988 CD tcl8 \U000000CD -1 {} {} + gb1988 CD replace \uFFFD -1 {} {} + gb1988 CD strict {} 0 {} {} + gb1988 CE tcl8 \U000000CE -1 {} {} + gb1988 CE replace \uFFFD -1 {} {} + gb1988 CE strict {} 0 {} {} + gb1988 CF tcl8 \U000000CF -1 {} {} + gb1988 CF replace \uFFFD -1 {} {} + gb1988 CF strict {} 0 {} {} + gb1988 D0 tcl8 \U000000D0 -1 {} {} + gb1988 D0 replace \uFFFD -1 {} {} + gb1988 D0 strict {} 0 {} {} + gb1988 D1 tcl8 \U000000D1 -1 {} {} + gb1988 D1 replace \uFFFD -1 {} {} + gb1988 D1 strict {} 0 {} {} + gb1988 D2 tcl8 \U000000D2 -1 {} {} + gb1988 D2 replace \uFFFD -1 {} {} + gb1988 D2 strict {} 0 {} {} + gb1988 D3 tcl8 \U000000D3 -1 {} {} + gb1988 D3 replace \uFFFD -1 {} {} + gb1988 D3 strict {} 0 {} {} + gb1988 D4 tcl8 \U000000D4 -1 {} {} + gb1988 D4 replace \uFFFD -1 {} {} + gb1988 D4 strict {} 0 {} {} + gb1988 D5 tcl8 \U000000D5 -1 {} {} + gb1988 D5 replace \uFFFD -1 {} {} + gb1988 D5 strict {} 0 {} {} + gb1988 D6 tcl8 \U000000D6 -1 {} {} + gb1988 D6 replace \uFFFD -1 {} {} + gb1988 D6 strict {} 0 {} {} + gb1988 D7 tcl8 \U000000D7 -1 {} {} + gb1988 D7 replace \uFFFD -1 {} {} + gb1988 D7 strict {} 0 {} {} + gb1988 D8 tcl8 \U000000D8 -1 {} {} + gb1988 D8 replace \uFFFD -1 {} {} + gb1988 D8 strict {} 0 {} {} + gb1988 D9 tcl8 \U000000D9 -1 {} {} + gb1988 D9 replace \uFFFD -1 {} {} + gb1988 D9 strict {} 0 {} {} + gb1988 DA tcl8 \U000000DA -1 {} {} + gb1988 DA replace \uFFFD -1 {} {} + gb1988 DA strict {} 0 {} {} + gb1988 DB tcl8 \U000000DB -1 {} {} + gb1988 DB replace \uFFFD -1 {} {} + gb1988 DB strict {} 0 {} {} + gb1988 DC tcl8 \U000000DC -1 {} {} + gb1988 DC replace \uFFFD -1 {} {} + gb1988 DC strict {} 0 {} {} + gb1988 DD tcl8 \U000000DD -1 {} {} + gb1988 DD replace \uFFFD -1 {} {} + gb1988 DD strict {} 0 {} {} + gb1988 DE tcl8 \U000000DE -1 {} {} + gb1988 DE replace \uFFFD -1 {} {} + gb1988 DE strict {} 0 {} {} + gb1988 DF tcl8 \U000000DF -1 {} {} + gb1988 DF replace \uFFFD -1 {} {} + gb1988 DF strict {} 0 {} {} + gb1988 E0 tcl8 \U000000E0 -1 {} {} + gb1988 E0 replace \uFFFD -1 {} {} + gb1988 E0 strict {} 0 {} {} + gb1988 E1 tcl8 \U000000E1 -1 {} {} + gb1988 E1 replace \uFFFD -1 {} {} + gb1988 E1 strict {} 0 {} {} + gb1988 E2 tcl8 \U000000E2 -1 {} {} + gb1988 E2 replace \uFFFD -1 {} {} + gb1988 E2 strict {} 0 {} {} + gb1988 E3 tcl8 \U000000E3 -1 {} {} + gb1988 E3 replace \uFFFD -1 {} {} + gb1988 E3 strict {} 0 {} {} + gb1988 E4 tcl8 \U000000E4 -1 {} {} + gb1988 E4 replace \uFFFD -1 {} {} + gb1988 E4 strict {} 0 {} {} + gb1988 E5 tcl8 \U000000E5 -1 {} {} + gb1988 E5 replace \uFFFD -1 {} {} + gb1988 E5 strict {} 0 {} {} + gb1988 E6 tcl8 \U000000E6 -1 {} {} + gb1988 E6 replace \uFFFD -1 {} {} + gb1988 E6 strict {} 0 {} {} + gb1988 E7 tcl8 \U000000E7 -1 {} {} + gb1988 E7 replace \uFFFD -1 {} {} + gb1988 E7 strict {} 0 {} {} + gb1988 E8 tcl8 \U000000E8 -1 {} {} + gb1988 E8 replace \uFFFD -1 {} {} + gb1988 E8 strict {} 0 {} {} + gb1988 E9 tcl8 \U000000E9 -1 {} {} + gb1988 E9 replace \uFFFD -1 {} {} + gb1988 E9 strict {} 0 {} {} + gb1988 EA tcl8 \U000000EA -1 {} {} + gb1988 EA replace \uFFFD -1 {} {} + gb1988 EA strict {} 0 {} {} + gb1988 EB tcl8 \U000000EB -1 {} {} + gb1988 EB replace \uFFFD -1 {} {} + gb1988 EB strict {} 0 {} {} + gb1988 EC tcl8 \U000000EC -1 {} {} + gb1988 EC replace \uFFFD -1 {} {} + gb1988 EC strict {} 0 {} {} + gb1988 ED tcl8 \U000000ED -1 {} {} + gb1988 ED replace \uFFFD -1 {} {} + gb1988 ED strict {} 0 {} {} + gb1988 EE tcl8 \U000000EE -1 {} {} + gb1988 EE replace \uFFFD -1 {} {} + gb1988 EE strict {} 0 {} {} + gb1988 EF tcl8 \U000000EF -1 {} {} + gb1988 EF replace \uFFFD -1 {} {} + gb1988 EF strict {} 0 {} {} + gb1988 F0 tcl8 \U000000F0 -1 {} {} + gb1988 F0 replace \uFFFD -1 {} {} + gb1988 F0 strict {} 0 {} {} + gb1988 F1 tcl8 \U000000F1 -1 {} {} + gb1988 F1 replace \uFFFD -1 {} {} + gb1988 F1 strict {} 0 {} {} + gb1988 F2 tcl8 \U000000F2 -1 {} {} + gb1988 F2 replace \uFFFD -1 {} {} + gb1988 F2 strict {} 0 {} {} + gb1988 F3 tcl8 \U000000F3 -1 {} {} + gb1988 F3 replace \uFFFD -1 {} {} + gb1988 F3 strict {} 0 {} {} + gb1988 F4 tcl8 \U000000F4 -1 {} {} + gb1988 F4 replace \uFFFD -1 {} {} + gb1988 F4 strict {} 0 {} {} + gb1988 F5 tcl8 \U000000F5 -1 {} {} + gb1988 F5 replace \uFFFD -1 {} {} + gb1988 F5 strict {} 0 {} {} + gb1988 F6 tcl8 \U000000F6 -1 {} {} + gb1988 F6 replace \uFFFD -1 {} {} + gb1988 F6 strict {} 0 {} {} + gb1988 F7 tcl8 \U000000F7 -1 {} {} + gb1988 F7 replace \uFFFD -1 {} {} + gb1988 F7 strict {} 0 {} {} + gb1988 F8 tcl8 \U000000F8 -1 {} {} + gb1988 F8 replace \uFFFD -1 {} {} + gb1988 F8 strict {} 0 {} {} + gb1988 F9 tcl8 \U000000F9 -1 {} {} + gb1988 F9 replace \uFFFD -1 {} {} + gb1988 F9 strict {} 0 {} {} + gb1988 FA tcl8 \U000000FA -1 {} {} + gb1988 FA replace \uFFFD -1 {} {} + gb1988 FA strict {} 0 {} {} + gb1988 FB tcl8 \U000000FB -1 {} {} + gb1988 FB replace \uFFFD -1 {} {} + gb1988 FB strict {} 0 {} {} + gb1988 FC tcl8 \U000000FC -1 {} {} + gb1988 FC replace \uFFFD -1 {} {} + gb1988 FC strict {} 0 {} {} + gb1988 FD tcl8 \U000000FD -1 {} {} + gb1988 FD replace \uFFFD -1 {} {} + gb1988 FD strict {} 0 {} {} + gb1988 FE tcl8 \U000000FE -1 {} {} + gb1988 FE replace \uFFFD -1 {} {} + gb1988 FE strict {} 0 {} {} + gb1988 FF tcl8 \U000000FF -1 {} {} + gb1988 FF replace \uFFFD -1 {} {} + gb1988 FF strict {} 0 {} {} +}; # gb1988 + +# gb1988 - invalid byte sequences +lappend encUnencodableStrings {*}{ + gb1988 \U00000024 tcl8 1A -1 {} {} + gb1988 \U00000024 replace 1A -1 {} {} + gb1988 \U00000024 strict {} 0 {} {} + gb1988 \U00000400 tcl8 1A -1 {} {} + gb1988 \U00000400 replace 1A -1 {} {} + gb1988 \U00000400 strict {} 0 {} {} + gb1988 \U0000D800 tcl8 1A -1 {} {} + gb1988 \U0000D800 replace 1A -1 {} {} + gb1988 \U0000D800 strict {} 0 {} {} + gb1988 \U0000DC00 tcl8 1A -1 {} {} + gb1988 \U0000DC00 replace 1A -1 {} {} + gb1988 \U0000DC00 strict {} 0 {} {} + gb1988 \U00010000 tcl8 1A -1 {} {} + gb1988 \U00010000 replace 1A -1 {} {} + gb1988 \U00010000 strict {} 0 {} {} + gb1988 \U0010FFFF tcl8 1A -1 {} {} + gb1988 \U0010FFFF replace 1A -1 {} {} + gb1988 \U0010FFFF strict {} 0 {} {} +}; # gb1988 + +# +# iso8859-1 (generated from glibc-ISO_8859_1-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-1 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-1 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-1 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-1 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF} +} -result {} + +# iso8859-1 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-1 + +# iso8859-1 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-1 \U00000400 tcl8 1A -1 {} {} + iso8859-1 \U00000400 replace 1A -1 {} {} + iso8859-1 \U00000400 strict {} 0 {} {} + iso8859-1 \U0000D800 tcl8 1A -1 {} {} + iso8859-1 \U0000D800 replace 1A -1 {} {} + iso8859-1 \U0000D800 strict {} 0 {} {} + iso8859-1 \U0000DC00 tcl8 1A -1 {} {} + iso8859-1 \U0000DC00 replace 1A -1 {} {} + iso8859-1 \U0000DC00 strict {} 0 {} {} + iso8859-1 \U00010000 tcl8 1A -1 {} {} + iso8859-1 \U00010000 replace 1A -1 {} {} + iso8859-1 \U00010000 strict {} 0 {} {} + iso8859-1 \U0010FFFF tcl8 1A -1 {} {} + iso8859-1 \U0010FFFF replace 1A -1 {} {} + iso8859-1 \U0010FFFF strict {} 0 {} {} +}; # iso8859-1 + +# +# iso8859-2 (generated from glibc-ISO_8859_2-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-2 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-2 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00A7 A7 00A8 A8 00AD AD 00B0 B0 00B4 B4 00B8 B8 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C9 C9 00CB CB 00CD CD 00CE CE 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00DA DA 00DC DC 00DD DD 00DF DF 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E9 E9 00EB EB 00ED ED 00EE EE 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00FA FA 00FC FC 00FD FD 0102 C3 0103 E3 0104 A1 0105 B1 0106 C6 0107 E6 010C C8 010D E8 010E CF 010F EF 0110 D0 0111 F0 0118 CA 0119 EA 011A CC 011B EC 0139 C5 013A E5 013D A5 013E B5 0141 A3 0142 B3 0143 D1 0144 F1 0147 D2 0148 F2 0150 D5 0151 F5 0154 C0 0155 E0 0158 D8 0159 F8 015A A6 015B B6 015E AA 015F BA 0160 A9 0161 B9 0162 DE 0163 FE 0164 AB 0165 BB 016E D9 016F F9 0170 DB 0171 FB 0179 AC 017A BC 017B AF 017C BF 017D AE 017E BE 02C7 B7 02D8 A2 02D9 FF 02DB B2 02DD BD} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-2 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-2 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00A7 A7 00A8 A8 00AD AD 00B0 B0 00B4 B4 00B8 B8 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C9 C9 00CB CB 00CD CD 00CE CE 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00DA DA 00DC DC 00DD DD 00DF DF 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E9 E9 00EB EB 00ED ED 00EE EE 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00FA FA 00FC FC 00FD FD 0102 C3 0103 E3 0104 A1 0105 B1 0106 C6 0107 E6 010C C8 010D E8 010E CF 010F EF 0110 D0 0111 F0 0118 CA 0119 EA 011A CC 011B EC 0139 C5 013A E5 013D A5 013E B5 0141 A3 0142 B3 0143 D1 0144 F1 0147 D2 0148 F2 0150 D5 0151 F5 0154 C0 0155 E0 0158 D8 0159 F8 015A A6 015B B6 015E AA 015F BA 0160 A9 0161 B9 0162 DE 0163 FE 0164 AB 0165 BB 016E D9 016F F9 0170 DB 0171 FB 0179 AC 017A BC 017B AF 017C BF 017D AE 017E BE 02C7 B7 02D8 A2 02D9 FF 02DB B2 02DD BD} +} -result {} + +# iso8859-2 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-2 + +# iso8859-2 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-2 \U000000A1 tcl8 1A -1 {} {} + iso8859-2 \U000000A1 replace 1A -1 {} {} + iso8859-2 \U000000A1 strict {} 0 {} {} + iso8859-2 \U00000400 tcl8 1A -1 {} {} + iso8859-2 \U00000400 replace 1A -1 {} {} + iso8859-2 \U00000400 strict {} 0 {} {} + iso8859-2 \U0000D800 tcl8 1A -1 {} {} + iso8859-2 \U0000D800 replace 1A -1 {} {} + iso8859-2 \U0000D800 strict {} 0 {} {} + iso8859-2 \U0000DC00 tcl8 1A -1 {} {} + iso8859-2 \U0000DC00 replace 1A -1 {} {} + iso8859-2 \U0000DC00 strict {} 0 {} {} + iso8859-2 \U00010000 tcl8 1A -1 {} {} + iso8859-2 \U00010000 replace 1A -1 {} {} + iso8859-2 \U00010000 strict {} 0 {} {} + iso8859-2 \U0010FFFF tcl8 1A -1 {} {} + iso8859-2 \U0010FFFF replace 1A -1 {} {} + iso8859-2 \U0010FFFF strict {} 0 {} {} +}; # iso8859-2 + +# +# iso8859-3 (generated from glibc-ISO_8859_3-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-3 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-3 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A4 A4 00A7 A7 00A8 A8 00AD AD 00B0 B0 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B7 B7 00B8 B8 00BD BD 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00F9 F9 00FA FA 00FB FB 00FC FC 0108 C6 0109 E6 010A C5 010B E5 011C D8 011D F8 011E AB 011F BB 0120 D5 0121 F5 0124 A6 0125 B6 0126 A1 0127 B1 0130 A9 0131 B9 0134 AC 0135 BC 015C DE 015D FE 015E AA 015F BA 016C DD 016D FD 017B AF 017C BF 02D8 A2 02D9 FF} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-3 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-3 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A4 A4 00A7 A7 00A8 A8 00AD AD 00B0 B0 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B7 B7 00B8 B8 00BD BD 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D6 D6 00D7 D7 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F6 F6 00F7 F7 00F9 F9 00FA FA 00FB FB 00FC FC 0108 C6 0109 E6 010A C5 010B E5 011C D8 011D F8 011E AB 011F BB 0120 D5 0121 F5 0124 A6 0125 B6 0126 A1 0127 B1 0130 A9 0131 B9 0134 AC 0135 BC 015C DE 015D FE 015E AA 015F BA 016C DD 016D FD 017B AF 017C BF 02D8 A2 02D9 FF} +} -result {} + +# iso8859-3 - invalid byte sequences +lappend encInvalidBytes {*}{ + iso8859-3 A5 tcl8 \U000000A5 -1 {} {} + iso8859-3 A5 replace \uFFFD -1 {} {} + iso8859-3 A5 strict {} 0 {} {} + iso8859-3 AE tcl8 \U000000AE -1 {} {} + iso8859-3 AE replace \uFFFD -1 {} {} + iso8859-3 AE strict {} 0 {} {} + iso8859-3 BE tcl8 \U000000BE -1 {} {} + iso8859-3 BE replace \uFFFD -1 {} {} + iso8859-3 BE strict {} 0 {} {} + iso8859-3 C3 tcl8 \U000000C3 -1 {} {} + iso8859-3 C3 replace \uFFFD -1 {} {} + iso8859-3 C3 strict {} 0 {} {} + iso8859-3 D0 tcl8 \U000000D0 -1 {} {} + iso8859-3 D0 replace \uFFFD -1 {} {} + iso8859-3 D0 strict {} 0 {} {} + iso8859-3 E3 tcl8 \U000000E3 -1 {} {} + iso8859-3 E3 replace \uFFFD -1 {} {} + iso8859-3 E3 strict {} 0 {} {} + iso8859-3 F0 tcl8 \U000000F0 -1 {} {} + iso8859-3 F0 replace \uFFFD -1 {} {} + iso8859-3 F0 strict {} 0 {} {} +}; # iso8859-3 + +# iso8859-3 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-3 \U000000A1 tcl8 1A -1 {} {} + iso8859-3 \U000000A1 replace 1A -1 {} {} + iso8859-3 \U000000A1 strict {} 0 {} {} + iso8859-3 \U00000400 tcl8 1A -1 {} {} + iso8859-3 \U00000400 replace 1A -1 {} {} + iso8859-3 \U00000400 strict {} 0 {} {} + iso8859-3 \U0000D800 tcl8 1A -1 {} {} + iso8859-3 \U0000D800 replace 1A -1 {} {} + iso8859-3 \U0000D800 strict {} 0 {} {} + iso8859-3 \U0000DC00 tcl8 1A -1 {} {} + iso8859-3 \U0000DC00 replace 1A -1 {} {} + iso8859-3 \U0000DC00 strict {} 0 {} {} + iso8859-3 \U00010000 tcl8 1A -1 {} {} + iso8859-3 \U00010000 replace 1A -1 {} {} + iso8859-3 \U00010000 strict {} 0 {} {} + iso8859-3 \U0010FFFF tcl8 1A -1 {} {} + iso8859-3 \U0010FFFF replace 1A -1 {} {} + iso8859-3 \U0010FFFF strict {} 0 {} {} +}; # iso8859-3 + +# +# iso8859-4 (generated from glibc-ISO_8859_4-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-4 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-4 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00A7 A7 00A8 A8 00AD AD 00AF AF 00B0 B0 00B4 B4 00B8 B8 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C9 C9 00CB CB 00CD CD 00CE CE 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00DA DA 00DB DB 00DC DC 00DF DF 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E9 E9 00EB EB 00ED ED 00EE EE 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00FA FA 00FB FB 00FC FC 0100 C0 0101 E0 0104 A1 0105 B1 010C C8 010D E8 0110 D0 0111 F0 0112 AA 0113 BA 0116 CC 0117 EC 0118 CA 0119 EA 0122 AB 0123 BB 0128 A5 0129 B5 012A CF 012B EF 012E C7 012F E7 0136 D3 0137 F3 0138 A2 013B A6 013C B6 0145 D1 0146 F1 014A BD 014B BF 014C D2 014D F2 0156 A3 0157 B3 0160 A9 0161 B9 0166 AC 0167 BC 0168 DD 0169 FD 016A DE 016B FE 0172 D9 0173 F9 017D AE 017E BE 02C7 B7 02D9 FF 02DB B2} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-4 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-4 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00A7 A7 00A8 A8 00AD AD 00AF AF 00B0 B0 00B4 B4 00B8 B8 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C9 C9 00CB CB 00CD CD 00CE CE 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00DA DA 00DB DB 00DC DC 00DF DF 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E9 E9 00EB EB 00ED ED 00EE EE 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00FA FA 00FB FB 00FC FC 0100 C0 0101 E0 0104 A1 0105 B1 010C C8 010D E8 0110 D0 0111 F0 0112 AA 0113 BA 0116 CC 0117 EC 0118 CA 0119 EA 0122 AB 0123 BB 0128 A5 0129 B5 012A CF 012B EF 012E C7 012F E7 0136 D3 0137 F3 0138 A2 013B A6 013C B6 0145 D1 0146 F1 014A BD 014B BF 014C D2 014D F2 0156 A3 0157 B3 0160 A9 0161 B9 0166 AC 0167 BC 0168 DD 0169 FD 016A DE 016B FE 0172 D9 0173 F9 017D AE 017E BE 02C7 B7 02D9 FF 02DB B2} +} -result {} + +# iso8859-4 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-4 + +# iso8859-4 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-4 \U000000A1 tcl8 1A -1 {} {} + iso8859-4 \U000000A1 replace 1A -1 {} {} + iso8859-4 \U000000A1 strict {} 0 {} {} + iso8859-4 \U00000400 tcl8 1A -1 {} {} + iso8859-4 \U00000400 replace 1A -1 {} {} + iso8859-4 \U00000400 strict {} 0 {} {} + iso8859-4 \U0000D800 tcl8 1A -1 {} {} + iso8859-4 \U0000D800 replace 1A -1 {} {} + iso8859-4 \U0000D800 strict {} 0 {} {} + iso8859-4 \U0000DC00 tcl8 1A -1 {} {} + iso8859-4 \U0000DC00 replace 1A -1 {} {} + iso8859-4 \U0000DC00 strict {} 0 {} {} + iso8859-4 \U00010000 tcl8 1A -1 {} {} + iso8859-4 \U00010000 replace 1A -1 {} {} + iso8859-4 \U00010000 strict {} 0 {} {} + iso8859-4 \U0010FFFF tcl8 1A -1 {} {} + iso8859-4 \U0010FFFF replace 1A -1 {} {} + iso8859-4 \U0010FFFF strict {} 0 {} {} +}; # iso8859-4 + +# +# iso8859-5 (generated from glibc-ISO_8859_5-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-5 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-5 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 FD 00AD AD 0401 A1 0402 A2 0403 A3 0404 A4 0405 A5 0406 A6 0407 A7 0408 A8 0409 A9 040A AA 040B AB 040C AC 040E AE 040F AF 0410 B0 0411 B1 0412 B2 0413 B3 0414 B4 0415 B5 0416 B6 0417 B7 0418 B8 0419 B9 041A BA 041B BB 041C BC 041D BD 041E BE 041F BF 0420 C0 0421 C1 0422 C2 0423 C3 0424 C4 0425 C5 0426 C6 0427 C7 0428 C8 0429 C9 042A CA 042B CB 042C CC 042D CD 042E CE 042F CF 0430 D0 0431 D1 0432 D2 0433 D3 0434 D4 0435 D5 0436 D6 0437 D7 0438 D8 0439 D9 043A DA 043B DB 043C DC 043D DD 043E DE 043F DF 0440 E0 0441 E1 0442 E2 0443 E3 0444 E4 0445 E5 0446 E6 0447 E7 0448 E8 0449 E9 044A EA 044B EB 044C EC 044D ED 044E EE 044F EF 0451 F1 0452 F2 0453 F3 0454 F4 0455 F5 0456 F6 0457 F7 0458 F8 0459 F9 045A FA 045B FB 045C FC 045E FE 045F FF 2116 F0} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-5 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-5 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 FD 00AD AD 0401 A1 0402 A2 0403 A3 0404 A4 0405 A5 0406 A6 0407 A7 0408 A8 0409 A9 040A AA 040B AB 040C AC 040E AE 040F AF 0410 B0 0411 B1 0412 B2 0413 B3 0414 B4 0415 B5 0416 B6 0417 B7 0418 B8 0419 B9 041A BA 041B BB 041C BC 041D BD 041E BE 041F BF 0420 C0 0421 C1 0422 C2 0423 C3 0424 C4 0425 C5 0426 C6 0427 C7 0428 C8 0429 C9 042A CA 042B CB 042C CC 042D CD 042E CE 042F CF 0430 D0 0431 D1 0432 D2 0433 D3 0434 D4 0435 D5 0436 D6 0437 D7 0438 D8 0439 D9 043A DA 043B DB 043C DC 043D DD 043E DE 043F DF 0440 E0 0441 E1 0442 E2 0443 E3 0444 E4 0445 E5 0446 E6 0447 E7 0448 E8 0449 E9 044A EA 044B EB 044C EC 044D ED 044E EE 044F EF 0451 F1 0452 F2 0453 F3 0454 F4 0455 F5 0456 F6 0457 F7 0458 F8 0459 F9 045A FA 045B FB 045C FC 045E FE 045F FF 2116 F0} +} -result {} + +# iso8859-5 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-5 + +# iso8859-5 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-5 \U000000A1 tcl8 1A -1 {} {} + iso8859-5 \U000000A1 replace 1A -1 {} {} + iso8859-5 \U000000A1 strict {} 0 {} {} + iso8859-5 \U00000400 tcl8 1A -1 {} {} + iso8859-5 \U00000400 replace 1A -1 {} {} + iso8859-5 \U00000400 strict {} 0 {} {} + iso8859-5 \U0000D800 tcl8 1A -1 {} {} + iso8859-5 \U0000D800 replace 1A -1 {} {} + iso8859-5 \U0000D800 strict {} 0 {} {} + iso8859-5 \U0000DC00 tcl8 1A -1 {} {} + iso8859-5 \U0000DC00 replace 1A -1 {} {} + iso8859-5 \U0000DC00 strict {} 0 {} {} + iso8859-5 \U00010000 tcl8 1A -1 {} {} + iso8859-5 \U00010000 replace 1A -1 {} {} + iso8859-5 \U00010000 strict {} 0 {} {} + iso8859-5 \U0010FFFF tcl8 1A -1 {} {} + iso8859-5 \U0010FFFF replace 1A -1 {} {} + iso8859-5 \U0010FFFF strict {} 0 {} {} +}; # iso8859-5 + +# +# iso8859-6 (generated from glibc-ISO_8859_6-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-6 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-6 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00AD AD 060C AC 061B BB 061F BF 0621 C1 0622 C2 0623 C3 0624 C4 0625 C5 0626 C6 0627 C7 0628 C8 0629 C9 062A CA 062B CB 062C CC 062D CD 062E CE 062F CF 0630 D0 0631 D1 0632 D2 0633 D3 0634 D4 0635 D5 0636 D6 0637 D7 0638 D8 0639 D9 063A DA 0640 E0 0641 E1 0642 E2 0643 E3 0644 E4 0645 E5 0646 E6 0647 E7 0648 E8 0649 E9 064A EA 064B EB 064C EC 064D ED 064E EE 064F EF 0650 F0 0651 F1 0652 F2} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-6 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-6 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A4 A4 00AD AD 060C AC 061B BB 061F BF 0621 C1 0622 C2 0623 C3 0624 C4 0625 C5 0626 C6 0627 C7 0628 C8 0629 C9 062A CA 062B CB 062C CC 062D CD 062E CE 062F CF 0630 D0 0631 D1 0632 D2 0633 D3 0634 D4 0635 D5 0636 D6 0637 D7 0638 D8 0639 D9 063A DA 0640 E0 0641 E1 0642 E2 0643 E3 0644 E4 0645 E5 0646 E6 0647 E7 0648 E8 0649 E9 064A EA 064B EB 064C EC 064D ED 064E EE 064F EF 0650 F0 0651 F1 0652 F2} +} -result {} + +# iso8859-6 - invalid byte sequences +lappend encInvalidBytes {*}{ + iso8859-6 A1 tcl8 \U000000A1 -1 {} {} + iso8859-6 A1 replace \uFFFD -1 {} {} + iso8859-6 A1 strict {} 0 {} {} + iso8859-6 A2 tcl8 \U000000A2 -1 {} {} + iso8859-6 A2 replace \uFFFD -1 {} {} + iso8859-6 A2 strict {} 0 {} {} + iso8859-6 A3 tcl8 \U000000A3 -1 {} {} + iso8859-6 A3 replace \uFFFD -1 {} {} + iso8859-6 A3 strict {} 0 {} {} + iso8859-6 A5 tcl8 \U000000A5 -1 {} {} + iso8859-6 A5 replace \uFFFD -1 {} {} + iso8859-6 A5 strict {} 0 {} {} + iso8859-6 A6 tcl8 \U000000A6 -1 {} {} + iso8859-6 A6 replace \uFFFD -1 {} {} + iso8859-6 A6 strict {} 0 {} {} + iso8859-6 A7 tcl8 \U000000A7 -1 {} {} + iso8859-6 A7 replace \uFFFD -1 {} {} + iso8859-6 A7 strict {} 0 {} {} + iso8859-6 A8 tcl8 \U000000A8 -1 {} {} + iso8859-6 A8 replace \uFFFD -1 {} {} + iso8859-6 A8 strict {} 0 {} {} + iso8859-6 A9 tcl8 \U000000A9 -1 {} {} + iso8859-6 A9 replace \uFFFD -1 {} {} + iso8859-6 A9 strict {} 0 {} {} + iso8859-6 AA tcl8 \U000000AA -1 {} {} + iso8859-6 AA replace \uFFFD -1 {} {} + iso8859-6 AA strict {} 0 {} {} + iso8859-6 AB tcl8 \U000000AB -1 {} {} + iso8859-6 AB replace \uFFFD -1 {} {} + iso8859-6 AB strict {} 0 {} {} + iso8859-6 AE tcl8 \U000000AE -1 {} {} + iso8859-6 AE replace \uFFFD -1 {} {} + iso8859-6 AE strict {} 0 {} {} + iso8859-6 AF tcl8 \U000000AF -1 {} {} + iso8859-6 AF replace \uFFFD -1 {} {} + iso8859-6 AF strict {} 0 {} {} + iso8859-6 B0 tcl8 \U000000B0 -1 {} {} + iso8859-6 B0 replace \uFFFD -1 {} {} + iso8859-6 B0 strict {} 0 {} {} + iso8859-6 B1 tcl8 \U000000B1 -1 {} {} + iso8859-6 B1 replace \uFFFD -1 {} {} + iso8859-6 B1 strict {} 0 {} {} + iso8859-6 B2 tcl8 \U000000B2 -1 {} {} + iso8859-6 B2 replace \uFFFD -1 {} {} + iso8859-6 B2 strict {} 0 {} {} + iso8859-6 B3 tcl8 \U000000B3 -1 {} {} + iso8859-6 B3 replace \uFFFD -1 {} {} + iso8859-6 B3 strict {} 0 {} {} + iso8859-6 B4 tcl8 \U000000B4 -1 {} {} + iso8859-6 B4 replace \uFFFD -1 {} {} + iso8859-6 B4 strict {} 0 {} {} + iso8859-6 B5 tcl8 \U000000B5 -1 {} {} + iso8859-6 B5 replace \uFFFD -1 {} {} + iso8859-6 B5 strict {} 0 {} {} + iso8859-6 B6 tcl8 \U000000B6 -1 {} {} + iso8859-6 B6 replace \uFFFD -1 {} {} + iso8859-6 B6 strict {} 0 {} {} + iso8859-6 B7 tcl8 \U000000B7 -1 {} {} + iso8859-6 B7 replace \uFFFD -1 {} {} + iso8859-6 B7 strict {} 0 {} {} + iso8859-6 B8 tcl8 \U000000B8 -1 {} {} + iso8859-6 B8 replace \uFFFD -1 {} {} + iso8859-6 B8 strict {} 0 {} {} + iso8859-6 B9 tcl8 \U000000B9 -1 {} {} + iso8859-6 B9 replace \uFFFD -1 {} {} + iso8859-6 B9 strict {} 0 {} {} + iso8859-6 BA tcl8 \U000000BA -1 {} {} + iso8859-6 BA replace \uFFFD -1 {} {} + iso8859-6 BA strict {} 0 {} {} + iso8859-6 BC tcl8 \U000000BC -1 {} {} + iso8859-6 BC replace \uFFFD -1 {} {} + iso8859-6 BC strict {} 0 {} {} + iso8859-6 BD tcl8 \U000000BD -1 {} {} + iso8859-6 BD replace \uFFFD -1 {} {} + iso8859-6 BD strict {} 0 {} {} + iso8859-6 BE tcl8 \U000000BE -1 {} {} + iso8859-6 BE replace \uFFFD -1 {} {} + iso8859-6 BE strict {} 0 {} {} + iso8859-6 C0 tcl8 \U000000C0 -1 {} {} + iso8859-6 C0 replace \uFFFD -1 {} {} + iso8859-6 C0 strict {} 0 {} {} + iso8859-6 DB tcl8 \U000000DB -1 {} {} + iso8859-6 DB replace \uFFFD -1 {} {} + iso8859-6 DB strict {} 0 {} {} + iso8859-6 DC tcl8 \U000000DC -1 {} {} + iso8859-6 DC replace \uFFFD -1 {} {} + iso8859-6 DC strict {} 0 {} {} + iso8859-6 DD tcl8 \U000000DD -1 {} {} + iso8859-6 DD replace \uFFFD -1 {} {} + iso8859-6 DD strict {} 0 {} {} + iso8859-6 DE tcl8 \U000000DE -1 {} {} + iso8859-6 DE replace \uFFFD -1 {} {} + iso8859-6 DE strict {} 0 {} {} + iso8859-6 DF tcl8 \U000000DF -1 {} {} + iso8859-6 DF replace \uFFFD -1 {} {} + iso8859-6 DF strict {} 0 {} {} + iso8859-6 F3 tcl8 \U000000F3 -1 {} {} + iso8859-6 F3 replace \uFFFD -1 {} {} + iso8859-6 F3 strict {} 0 {} {} + iso8859-6 F4 tcl8 \U000000F4 -1 {} {} + iso8859-6 F4 replace \uFFFD -1 {} {} + iso8859-6 F4 strict {} 0 {} {} + iso8859-6 F5 tcl8 \U000000F5 -1 {} {} + iso8859-6 F5 replace \uFFFD -1 {} {} + iso8859-6 F5 strict {} 0 {} {} + iso8859-6 F6 tcl8 \U000000F6 -1 {} {} + iso8859-6 F6 replace \uFFFD -1 {} {} + iso8859-6 F6 strict {} 0 {} {} + iso8859-6 F7 tcl8 \U000000F7 -1 {} {} + iso8859-6 F7 replace \uFFFD -1 {} {} + iso8859-6 F7 strict {} 0 {} {} + iso8859-6 F8 tcl8 \U000000F8 -1 {} {} + iso8859-6 F8 replace \uFFFD -1 {} {} + iso8859-6 F8 strict {} 0 {} {} + iso8859-6 F9 tcl8 \U000000F9 -1 {} {} + iso8859-6 F9 replace \uFFFD -1 {} {} + iso8859-6 F9 strict {} 0 {} {} + iso8859-6 FA tcl8 \U000000FA -1 {} {} + iso8859-6 FA replace \uFFFD -1 {} {} + iso8859-6 FA strict {} 0 {} {} + iso8859-6 FB tcl8 \U000000FB -1 {} {} + iso8859-6 FB replace \uFFFD -1 {} {} + iso8859-6 FB strict {} 0 {} {} + iso8859-6 FC tcl8 \U000000FC -1 {} {} + iso8859-6 FC replace \uFFFD -1 {} {} + iso8859-6 FC strict {} 0 {} {} + iso8859-6 FD tcl8 \U000000FD -1 {} {} + iso8859-6 FD replace \uFFFD -1 {} {} + iso8859-6 FD strict {} 0 {} {} + iso8859-6 FE tcl8 \U000000FE -1 {} {} + iso8859-6 FE replace \uFFFD -1 {} {} + iso8859-6 FE strict {} 0 {} {} + iso8859-6 FF tcl8 \U000000FF -1 {} {} + iso8859-6 FF replace \uFFFD -1 {} {} + iso8859-6 FF strict {} 0 {} {} +}; # iso8859-6 + +# iso8859-6 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-6 \U000000A1 tcl8 1A -1 {} {} + iso8859-6 \U000000A1 replace 1A -1 {} {} + iso8859-6 \U000000A1 strict {} 0 {} {} + iso8859-6 \U00000400 tcl8 1A -1 {} {} + iso8859-6 \U00000400 replace 1A -1 {} {} + iso8859-6 \U00000400 strict {} 0 {} {} + iso8859-6 \U0000D800 tcl8 1A -1 {} {} + iso8859-6 \U0000D800 replace 1A -1 {} {} + iso8859-6 \U0000D800 strict {} 0 {} {} + iso8859-6 \U0000DC00 tcl8 1A -1 {} {} + iso8859-6 \U0000DC00 replace 1A -1 {} {} + iso8859-6 \U0000DC00 strict {} 0 {} {} + iso8859-6 \U00010000 tcl8 1A -1 {} {} + iso8859-6 \U00010000 replace 1A -1 {} {} + iso8859-6 \U00010000 strict {} 0 {} {} + iso8859-6 \U0010FFFF tcl8 1A -1 {} {} + iso8859-6 \U0010FFFF replace 1A -1 {} {} + iso8859-6 \U0010FFFF strict {} 0 {} {} +}; # iso8859-6 + +# +# iso8859-7 (generated from glibc-ISO_8859_7-2.3.3) + +test encoding-convertfrom-ucmCompare-iso8859-7 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-7 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B7 B7 00BB BB 00BD BD 037A AA 0384 B4 0385 B5 0386 B6 0388 B8 0389 B9 038A BA 038C BC 038E BE 038F BF 0390 C0 0391 C1 0392 C2 0393 C3 0394 C4 0395 C5 0396 C6 0397 C7 0398 C8 0399 C9 039A CA 039B CB 039C CC 039D CD 039E CE 039F CF 03A0 D0 03A1 D1 03A3 D3 03A4 D4 03A5 D5 03A6 D6 03A7 D7 03A8 D8 03A9 D9 03AA DA 03AB DB 03AC DC 03AD DD 03AE DE 03AF DF 03B0 E0 03B1 E1 03B2 E2 03B3 E3 03B4 E4 03B5 E5 03B6 E6 03B7 E7 03B8 E8 03B9 E9 03BA EA 03BB EB 03BC EC 03BD ED 03BE EE 03BF EF 03C0 F0 03C1 F1 03C2 F2 03C3 F3 03C4 F4 03C5 F5 03C6 F6 03C7 F7 03C8 F8 03C9 F9 03CA FA 03CB FB 03CC FC 03CD FD 03CE FE 2015 AF 2018 A1 2019 A2 20AC A4 20AF A5} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-7 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-7 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B7 B7 00BB BB 00BD BD 037A AA 0384 B4 0385 B5 0386 B6 0388 B8 0389 B9 038A BA 038C BC 038E BE 038F BF 0390 C0 0391 C1 0392 C2 0393 C3 0394 C4 0395 C5 0396 C6 0397 C7 0398 C8 0399 C9 039A CA 039B CB 039C CC 039D CD 039E CE 039F CF 03A0 D0 03A1 D1 03A3 D3 03A4 D4 03A5 D5 03A6 D6 03A7 D7 03A8 D8 03A9 D9 03AA DA 03AB DB 03AC DC 03AD DD 03AE DE 03AF DF 03B0 E0 03B1 E1 03B2 E2 03B3 E3 03B4 E4 03B5 E5 03B6 E6 03B7 E7 03B8 E8 03B9 E9 03BA EA 03BB EB 03BC EC 03BD ED 03BE EE 03BF EF 03C0 F0 03C1 F1 03C2 F2 03C3 F3 03C4 F4 03C5 F5 03C6 F6 03C7 F7 03C8 F8 03C9 F9 03CA FA 03CB FB 03CC FC 03CD FD 03CE FE 2015 AF 2018 A1 2019 A2 20AC A4 20AF A5} +} -result {} + +# iso8859-7 - invalid byte sequences +lappend encInvalidBytes {*}{ + iso8859-7 AE tcl8 \U000000AE -1 {} {} + iso8859-7 AE replace \uFFFD -1 {} {} + iso8859-7 AE strict {} 0 {} {} + iso8859-7 D2 tcl8 \U000000D2 -1 {} {} + iso8859-7 D2 replace \uFFFD -1 {} {} + iso8859-7 D2 strict {} 0 {} {} + iso8859-7 FF tcl8 \U000000FF -1 {} {} + iso8859-7 FF replace \uFFFD -1 {} {} + iso8859-7 FF strict {} 0 {} {} +}; # iso8859-7 + +# iso8859-7 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-7 \U000000A1 tcl8 1A -1 {} {} + iso8859-7 \U000000A1 replace 1A -1 {} {} + iso8859-7 \U000000A1 strict {} 0 {} {} + iso8859-7 \U00000400 tcl8 1A -1 {} {} + iso8859-7 \U00000400 replace 1A -1 {} {} + iso8859-7 \U00000400 strict {} 0 {} {} + iso8859-7 \U0000D800 tcl8 1A -1 {} {} + iso8859-7 \U0000D800 replace 1A -1 {} {} + iso8859-7 \U0000D800 strict {} 0 {} {} + iso8859-7 \U0000DC00 tcl8 1A -1 {} {} + iso8859-7 \U0000DC00 replace 1A -1 {} {} + iso8859-7 \U0000DC00 strict {} 0 {} {} + iso8859-7 \U00010000 tcl8 1A -1 {} {} + iso8859-7 \U00010000 replace 1A -1 {} {} + iso8859-7 \U00010000 strict {} 0 {} {} + iso8859-7 \U0010FFFF tcl8 1A -1 {} {} + iso8859-7 \U0010FFFF replace 1A -1 {} {} + iso8859-7 \U0010FFFF strict {} 0 {} {} +}; # iso8859-7 + +# +# iso8859-8 (generated from glibc-ISO_8859_8-2.3.3) + +test encoding-convertfrom-ucmCompare-iso8859-8 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-8 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00D7 AA 00F7 BA 05D0 E0 05D1 E1 05D2 E2 05D3 E3 05D4 E4 05D5 E5 05D6 E6 05D7 E7 05D8 E8 05D9 E9 05DA EA 05DB EB 05DC EC 05DD ED 05DE EE 05DF EF 05E0 F0 05E1 F1 05E2 F2 05E3 F3 05E4 F4 05E5 F5 05E6 F6 05E7 F7 05E8 F8 05E9 F9 05EA FA 200E FD 200F FE 2017 DF} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-8 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-8 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00D7 AA 00F7 BA 05D0 E0 05D1 E1 05D2 E2 05D3 E3 05D4 E4 05D5 E5 05D6 E6 05D7 E7 05D8 E8 05D9 E9 05DA EA 05DB EB 05DC EC 05DD ED 05DE EE 05DF EF 05E0 F0 05E1 F1 05E2 F2 05E3 F3 05E4 F4 05E5 F5 05E6 F6 05E7 F7 05E8 F8 05E9 F9 05EA FA 200E FD 200F FE 2017 DF} +} -result {} + +# iso8859-8 - invalid byte sequences +lappend encInvalidBytes {*}{ + iso8859-8 A1 tcl8 \U000000A1 -1 {} {} + iso8859-8 A1 replace \uFFFD -1 {} {} + iso8859-8 A1 strict {} 0 {} {} + iso8859-8 BF tcl8 \U000000BF -1 {} {} + iso8859-8 BF replace \uFFFD -1 {} {} + iso8859-8 BF strict {} 0 {} {} + iso8859-8 C0 tcl8 \U000000C0 -1 {} {} + iso8859-8 C0 replace \uFFFD -1 {} {} + iso8859-8 C0 strict {} 0 {} {} + iso8859-8 C1 tcl8 \U000000C1 -1 {} {} + iso8859-8 C1 replace \uFFFD -1 {} {} + iso8859-8 C1 strict {} 0 {} {} + iso8859-8 C2 tcl8 \U000000C2 -1 {} {} + iso8859-8 C2 replace \uFFFD -1 {} {} + iso8859-8 C2 strict {} 0 {} {} + iso8859-8 C3 tcl8 \U000000C3 -1 {} {} + iso8859-8 C3 replace \uFFFD -1 {} {} + iso8859-8 C3 strict {} 0 {} {} + iso8859-8 C4 tcl8 \U000000C4 -1 {} {} + iso8859-8 C4 replace \uFFFD -1 {} {} + iso8859-8 C4 strict {} 0 {} {} + iso8859-8 C5 tcl8 \U000000C5 -1 {} {} + iso8859-8 C5 replace \uFFFD -1 {} {} + iso8859-8 C5 strict {} 0 {} {} + iso8859-8 C6 tcl8 \U000000C6 -1 {} {} + iso8859-8 C6 replace \uFFFD -1 {} {} + iso8859-8 C6 strict {} 0 {} {} + iso8859-8 C7 tcl8 \U000000C7 -1 {} {} + iso8859-8 C7 replace \uFFFD -1 {} {} + iso8859-8 C7 strict {} 0 {} {} + iso8859-8 C8 tcl8 \U000000C8 -1 {} {} + iso8859-8 C8 replace \uFFFD -1 {} {} + iso8859-8 C8 strict {} 0 {} {} + iso8859-8 C9 tcl8 \U000000C9 -1 {} {} + iso8859-8 C9 replace \uFFFD -1 {} {} + iso8859-8 C9 strict {} 0 {} {} + iso8859-8 CA tcl8 \U000000CA -1 {} {} + iso8859-8 CA replace \uFFFD -1 {} {} + iso8859-8 CA strict {} 0 {} {} + iso8859-8 CB tcl8 \U000000CB -1 {} {} + iso8859-8 CB replace \uFFFD -1 {} {} + iso8859-8 CB strict {} 0 {} {} + iso8859-8 CC tcl8 \U000000CC -1 {} {} + iso8859-8 CC replace \uFFFD -1 {} {} + iso8859-8 CC strict {} 0 {} {} + iso8859-8 CD tcl8 \U000000CD -1 {} {} + iso8859-8 CD replace \uFFFD -1 {} {} + iso8859-8 CD strict {} 0 {} {} + iso8859-8 CE tcl8 \U000000CE -1 {} {} + iso8859-8 CE replace \uFFFD -1 {} {} + iso8859-8 CE strict {} 0 {} {} + iso8859-8 CF tcl8 \U000000CF -1 {} {} + iso8859-8 CF replace \uFFFD -1 {} {} + iso8859-8 CF strict {} 0 {} {} + iso8859-8 D0 tcl8 \U000000D0 -1 {} {} + iso8859-8 D0 replace \uFFFD -1 {} {} + iso8859-8 D0 strict {} 0 {} {} + iso8859-8 D1 tcl8 \U000000D1 -1 {} {} + iso8859-8 D1 replace \uFFFD -1 {} {} + iso8859-8 D1 strict {} 0 {} {} + iso8859-8 D2 tcl8 \U000000D2 -1 {} {} + iso8859-8 D2 replace \uFFFD -1 {} {} + iso8859-8 D2 strict {} 0 {} {} + iso8859-8 D3 tcl8 \U000000D3 -1 {} {} + iso8859-8 D3 replace \uFFFD -1 {} {} + iso8859-8 D3 strict {} 0 {} {} + iso8859-8 D4 tcl8 \U000000D4 -1 {} {} + iso8859-8 D4 replace \uFFFD -1 {} {} + iso8859-8 D4 strict {} 0 {} {} + iso8859-8 D5 tcl8 \U000000D5 -1 {} {} + iso8859-8 D5 replace \uFFFD -1 {} {} + iso8859-8 D5 strict {} 0 {} {} + iso8859-8 D6 tcl8 \U000000D6 -1 {} {} + iso8859-8 D6 replace \uFFFD -1 {} {} + iso8859-8 D6 strict {} 0 {} {} + iso8859-8 D7 tcl8 \U000000D7 -1 {} {} + iso8859-8 D7 replace \uFFFD -1 {} {} + iso8859-8 D7 strict {} 0 {} {} + iso8859-8 D8 tcl8 \U000000D8 -1 {} {} + iso8859-8 D8 replace \uFFFD -1 {} {} + iso8859-8 D8 strict {} 0 {} {} + iso8859-8 D9 tcl8 \U000000D9 -1 {} {} + iso8859-8 D9 replace \uFFFD -1 {} {} + iso8859-8 D9 strict {} 0 {} {} + iso8859-8 DA tcl8 \U000000DA -1 {} {} + iso8859-8 DA replace \uFFFD -1 {} {} + iso8859-8 DA strict {} 0 {} {} + iso8859-8 DB tcl8 \U000000DB -1 {} {} + iso8859-8 DB replace \uFFFD -1 {} {} + iso8859-8 DB strict {} 0 {} {} + iso8859-8 DC tcl8 \U000000DC -1 {} {} + iso8859-8 DC replace \uFFFD -1 {} {} + iso8859-8 DC strict {} 0 {} {} + iso8859-8 DD tcl8 \U000000DD -1 {} {} + iso8859-8 DD replace \uFFFD -1 {} {} + iso8859-8 DD strict {} 0 {} {} + iso8859-8 DE tcl8 \U000000DE -1 {} {} + iso8859-8 DE replace \uFFFD -1 {} {} + iso8859-8 DE strict {} 0 {} {} + iso8859-8 FB tcl8 \U000000FB -1 {} {} + iso8859-8 FB replace \uFFFD -1 {} {} + iso8859-8 FB strict {} 0 {} {} + iso8859-8 FC tcl8 \U000000FC -1 {} {} + iso8859-8 FC replace \uFFFD -1 {} {} + iso8859-8 FC strict {} 0 {} {} + iso8859-8 FF tcl8 \U000000FF -1 {} {} + iso8859-8 FF replace \uFFFD -1 {} {} + iso8859-8 FF strict {} 0 {} {} +}; # iso8859-8 + +# iso8859-8 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-8 \U000000A1 tcl8 1A -1 {} {} + iso8859-8 \U000000A1 replace 1A -1 {} {} + iso8859-8 \U000000A1 strict {} 0 {} {} + iso8859-8 \U00000400 tcl8 1A -1 {} {} + iso8859-8 \U00000400 replace 1A -1 {} {} + iso8859-8 \U00000400 strict {} 0 {} {} + iso8859-8 \U0000D800 tcl8 1A -1 {} {} + iso8859-8 \U0000D800 replace 1A -1 {} {} + iso8859-8 \U0000D800 strict {} 0 {} {} + iso8859-8 \U0000DC00 tcl8 1A -1 {} {} + iso8859-8 \U0000DC00 replace 1A -1 {} {} + iso8859-8 \U0000DC00 strict {} 0 {} {} + iso8859-8 \U00010000 tcl8 1A -1 {} {} + iso8859-8 \U00010000 replace 1A -1 {} {} + iso8859-8 \U00010000 strict {} 0 {} {} + iso8859-8 \U0010FFFF tcl8 1A -1 {} {} + iso8859-8 \U0010FFFF replace 1A -1 {} {} + iso8859-8 \U0010FFFF strict {} 0 {} {} +}; # iso8859-8 + +# +# iso8859-9 (generated from glibc-ISO_8859_9-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-9 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-9 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 011E D0 011F F0 0130 DD 0131 FD 015E DE 015F FE} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-9 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-9 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A4 A4 00A5 A5 00A6 A6 00A7 A7 00A8 A8 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B4 B4 00B5 B5 00B6 B6 00B7 B7 00B8 B8 00B9 B9 00BA BA 00BB BB 00BC BC 00BD BD 00BE BE 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 011E D0 011F F0 0130 DD 0131 FD 015E DE 015F FE} +} -result {} + +# iso8859-9 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-9 + +# iso8859-9 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-9 \U000000D0 tcl8 1A -1 {} {} + iso8859-9 \U000000D0 replace 1A -1 {} {} + iso8859-9 \U000000D0 strict {} 0 {} {} + iso8859-9 \U00000400 tcl8 1A -1 {} {} + iso8859-9 \U00000400 replace 1A -1 {} {} + iso8859-9 \U00000400 strict {} 0 {} {} + iso8859-9 \U0000D800 tcl8 1A -1 {} {} + iso8859-9 \U0000D800 replace 1A -1 {} {} + iso8859-9 \U0000D800 strict {} 0 {} {} + iso8859-9 \U0000DC00 tcl8 1A -1 {} {} + iso8859-9 \U0000DC00 replace 1A -1 {} {} + iso8859-9 \U0000DC00 strict {} 0 {} {} + iso8859-9 \U00010000 tcl8 1A -1 {} {} + iso8859-9 \U00010000 replace 1A -1 {} {} + iso8859-9 \U00010000 strict {} 0 {} {} + iso8859-9 \U0010FFFF tcl8 1A -1 {} {} + iso8859-9 \U0010FFFF replace 1A -1 {} {} + iso8859-9 \U0010FFFF strict {} 0 {} {} +}; # iso8859-9 + +# +# iso8859-10 (generated from glibc-ISO_8859_10-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-10 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-10 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 A7 00AD AD 00B0 B0 00B7 B7 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C9 C9 00CB CB 00CD CD 00CE CE 00CF CF 00D0 D0 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D8 D8 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E9 E9 00EB EB 00ED ED 00EE EE 00EF EF 00F0 F0 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F8 F8 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 0100 C0 0101 E0 0104 A1 0105 B1 010C C8 010D E8 0110 A9 0111 B9 0112 A2 0113 B2 0116 CC 0117 EC 0118 CA 0119 EA 0122 A3 0123 B3 0128 A5 0129 B5 012A A4 012B B4 012E C7 012F E7 0136 A6 0137 B6 0138 FF 013B A8 013C B8 0145 D1 0146 F1 014A AF 014B BF 014C D2 014D F2 0160 AA 0161 BA 0166 AB 0167 BB 0168 D7 0169 F7 016A AE 016B BE 0172 D9 0173 F9 017D AC 017E BC 2015 BD} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-10 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-10 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 A7 00AD AD 00B0 B0 00B7 B7 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C9 C9 00CB CB 00CD CD 00CE CE 00CF CF 00D0 D0 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D8 D8 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E9 E9 00EB EB 00ED ED 00EE EE 00EF EF 00F0 F0 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F8 F8 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 0100 C0 0101 E0 0104 A1 0105 B1 010C C8 010D E8 0110 A9 0111 B9 0112 A2 0113 B2 0116 CC 0117 EC 0118 CA 0119 EA 0122 A3 0123 B3 0128 A5 0129 B5 012A A4 012B B4 012E C7 012F E7 0136 A6 0137 B6 0138 FF 013B A8 013C B8 0145 D1 0146 F1 014A AF 014B BF 014C D2 014D F2 0160 AA 0161 BA 0166 AB 0167 BB 0168 D7 0169 F7 016A AE 016B BE 0172 D9 0173 F9 017D AC 017E BC 2015 BD} +} -result {} + +# iso8859-10 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-10 + +# iso8859-10 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-10 \U000000A1 tcl8 1A -1 {} {} + iso8859-10 \U000000A1 replace 1A -1 {} {} + iso8859-10 \U000000A1 strict {} 0 {} {} + iso8859-10 \U00000400 tcl8 1A -1 {} {} + iso8859-10 \U00000400 replace 1A -1 {} {} + iso8859-10 \U00000400 strict {} 0 {} {} + iso8859-10 \U0000D800 tcl8 1A -1 {} {} + iso8859-10 \U0000D800 replace 1A -1 {} {} + iso8859-10 \U0000D800 strict {} 0 {} {} + iso8859-10 \U0000DC00 tcl8 1A -1 {} {} + iso8859-10 \U0000DC00 replace 1A -1 {} {} + iso8859-10 \U0000DC00 strict {} 0 {} {} + iso8859-10 \U00010000 tcl8 1A -1 {} {} + iso8859-10 \U00010000 replace 1A -1 {} {} + iso8859-10 \U00010000 strict {} 0 {} {} + iso8859-10 \U0010FFFF tcl8 1A -1 {} {} + iso8859-10 \U0010FFFF replace 1A -1 {} {} + iso8859-10 \U0010FFFF strict {} 0 {} {} +}; # iso8859-10 + +# +# iso8859-11 (generated from glibc-ISO_8859_11-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-11 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-11 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 0E01 A1 0E02 A2 0E03 A3 0E04 A4 0E05 A5 0E06 A6 0E07 A7 0E08 A8 0E09 A9 0E0A AA 0E0B AB 0E0C AC 0E0D AD 0E0E AE 0E0F AF 0E10 B0 0E11 B1 0E12 B2 0E13 B3 0E14 B4 0E15 B5 0E16 B6 0E17 B7 0E18 B8 0E19 B9 0E1A BA 0E1B BB 0E1C BC 0E1D BD 0E1E BE 0E1F BF 0E20 C0 0E21 C1 0E22 C2 0E23 C3 0E24 C4 0E25 C5 0E26 C6 0E27 C7 0E28 C8 0E29 C9 0E2A CA 0E2B CB 0E2C CC 0E2D CD 0E2E CE 0E2F CF 0E30 D0 0E31 D1 0E32 D2 0E33 D3 0E34 D4 0E35 D5 0E36 D6 0E37 D7 0E38 D8 0E39 D9 0E3A DA 0E3F DF 0E40 E0 0E41 E1 0E42 E2 0E43 E3 0E44 E4 0E45 E5 0E46 E6 0E47 E7 0E48 E8 0E49 E9 0E4A EA 0E4B EB 0E4C EC 0E4D ED 0E4E EE 0E4F EF 0E50 F0 0E51 F1 0E52 F2 0E53 F3 0E54 F4 0E55 F5 0E56 F6 0E57 F7 0E58 F8 0E59 F9 0E5A FA 0E5B FB} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-11 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-11 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 0E01 A1 0E02 A2 0E03 A3 0E04 A4 0E05 A5 0E06 A6 0E07 A7 0E08 A8 0E09 A9 0E0A AA 0E0B AB 0E0C AC 0E0D AD 0E0E AE 0E0F AF 0E10 B0 0E11 B1 0E12 B2 0E13 B3 0E14 B4 0E15 B5 0E16 B6 0E17 B7 0E18 B8 0E19 B9 0E1A BA 0E1B BB 0E1C BC 0E1D BD 0E1E BE 0E1F BF 0E20 C0 0E21 C1 0E22 C2 0E23 C3 0E24 C4 0E25 C5 0E26 C6 0E27 C7 0E28 C8 0E29 C9 0E2A CA 0E2B CB 0E2C CC 0E2D CD 0E2E CE 0E2F CF 0E30 D0 0E31 D1 0E32 D2 0E33 D3 0E34 D4 0E35 D5 0E36 D6 0E37 D7 0E38 D8 0E39 D9 0E3A DA 0E3F DF 0E40 E0 0E41 E1 0E42 E2 0E43 E3 0E44 E4 0E45 E5 0E46 E6 0E47 E7 0E48 E8 0E49 E9 0E4A EA 0E4B EB 0E4C EC 0E4D ED 0E4E EE 0E4F EF 0E50 F0 0E51 F1 0E52 F2 0E53 F3 0E54 F4 0E55 F5 0E56 F6 0E57 F7 0E58 F8 0E59 F9 0E5A FA 0E5B FB} +} -result {} + +# iso8859-11 - invalid byte sequences +lappend encInvalidBytes {*}{ + iso8859-11 DB tcl8 \U000000DB -1 {} {} + iso8859-11 DB replace \uFFFD -1 {} {} + iso8859-11 DB strict {} 0 {} {} + iso8859-11 DC tcl8 \U000000DC -1 {} {} + iso8859-11 DC replace \uFFFD -1 {} {} + iso8859-11 DC strict {} 0 {} {} + iso8859-11 DD tcl8 \U000000DD -1 {} {} + iso8859-11 DD replace \uFFFD -1 {} {} + iso8859-11 DD strict {} 0 {} {} + iso8859-11 DE tcl8 \U000000DE -1 {} {} + iso8859-11 DE replace \uFFFD -1 {} {} + iso8859-11 DE strict {} 0 {} {} + iso8859-11 FC tcl8 \U000000FC -1 {} {} + iso8859-11 FC replace \uFFFD -1 {} {} + iso8859-11 FC strict {} 0 {} {} + iso8859-11 FD tcl8 \U000000FD -1 {} {} + iso8859-11 FD replace \uFFFD -1 {} {} + iso8859-11 FD strict {} 0 {} {} + iso8859-11 FE tcl8 \U000000FE -1 {} {} + iso8859-11 FE replace \uFFFD -1 {} {} + iso8859-11 FE strict {} 0 {} {} + iso8859-11 FF tcl8 \U000000FF -1 {} {} + iso8859-11 FF replace \uFFFD -1 {} {} + iso8859-11 FF strict {} 0 {} {} +}; # iso8859-11 + +# iso8859-11 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-11 \U000000A1 tcl8 1A -1 {} {} + iso8859-11 \U000000A1 replace 1A -1 {} {} + iso8859-11 \U000000A1 strict {} 0 {} {} + iso8859-11 \U00000400 tcl8 1A -1 {} {} + iso8859-11 \U00000400 replace 1A -1 {} {} + iso8859-11 \U00000400 strict {} 0 {} {} + iso8859-11 \U0000D800 tcl8 1A -1 {} {} + iso8859-11 \U0000D800 replace 1A -1 {} {} + iso8859-11 \U0000D800 strict {} 0 {} {} + iso8859-11 \U0000DC00 tcl8 1A -1 {} {} + iso8859-11 \U0000DC00 replace 1A -1 {} {} + iso8859-11 \U0000DC00 strict {} 0 {} {} + iso8859-11 \U00010000 tcl8 1A -1 {} {} + iso8859-11 \U00010000 replace 1A -1 {} {} + iso8859-11 \U00010000 strict {} 0 {} {} + iso8859-11 \U0010FFFF tcl8 1A -1 {} {} + iso8859-11 \U0010FFFF replace 1A -1 {} {} + iso8859-11 \U0010FFFF strict {} 0 {} {} +}; # iso8859-11 + +# +# iso8859-13 (generated from glibc-ISO_8859_13-2.3.3) + +test encoding-convertfrom-ucmCompare-iso8859-13 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-13 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A6 A6 00A7 A7 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00C4 C4 00C5 C5 00C6 AF 00C9 C9 00D3 D3 00D5 D5 00D6 D6 00D7 D7 00D8 A8 00DC DC 00DF DF 00E4 E4 00E5 E5 00E6 BF 00E9 E9 00F3 F3 00F5 F5 00F6 F6 00F7 F7 00F8 B8 00FC FC 0100 C2 0101 E2 0104 C0 0105 E0 0106 C3 0107 E3 010C C8 010D E8 0112 C7 0113 E7 0116 CB 0117 EB 0118 C6 0119 E6 0122 CC 0123 EC 012A CE 012B EE 012E C1 012F E1 0136 CD 0137 ED 013B CF 013C EF 0141 D9 0142 F9 0143 D1 0144 F1 0145 D2 0146 F2 014C D4 014D F4 0156 AA 0157 BA 015A DA 015B FA 0160 D0 0161 F0 016A DB 016B FB 0172 D8 0173 F8 0179 CA 017A EA 017B DD 017C FD 017D DE 017E FE 2019 FF 201C B4 201D A1 201E A5} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-13 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-13 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A2 A2 00A3 A3 00A4 A4 00A6 A6 00A7 A7 00A9 A9 00AB AB 00AC AC 00AD AD 00AE AE 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00B9 B9 00BB BB 00BC BC 00BD BD 00BE BE 00C4 C4 00C5 C5 00C6 AF 00C9 C9 00D3 D3 00D5 D5 00D6 D6 00D7 D7 00D8 A8 00DC DC 00DF DF 00E4 E4 00E5 E5 00E6 BF 00E9 E9 00F3 F3 00F5 F5 00F6 F6 00F7 F7 00F8 B8 00FC FC 0100 C2 0101 E2 0104 C0 0105 E0 0106 C3 0107 E3 010C C8 010D E8 0112 C7 0113 E7 0116 CB 0117 EB 0118 C6 0119 E6 0122 CC 0123 EC 012A CE 012B EE 012E C1 012F E1 0136 CD 0137 ED 013B CF 013C EF 0141 D9 0142 F9 0143 D1 0144 F1 0145 D2 0146 F2 014C D4 014D F4 0156 AA 0157 BA 015A DA 015B FA 0160 D0 0161 F0 016A DB 016B FB 0172 D8 0173 F8 0179 CA 017A EA 017B DD 017C FD 017D DE 017E FE 2019 FF 201C B4 201D A1 201E A5} +} -result {} + +# iso8859-13 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-13 + +# iso8859-13 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-13 \U000000A1 tcl8 1A -1 {} {} + iso8859-13 \U000000A1 replace 1A -1 {} {} + iso8859-13 \U000000A1 strict {} 0 {} {} + iso8859-13 \U00000400 tcl8 1A -1 {} {} + iso8859-13 \U00000400 replace 1A -1 {} {} + iso8859-13 \U00000400 strict {} 0 {} {} + iso8859-13 \U0000D800 tcl8 1A -1 {} {} + iso8859-13 \U0000D800 replace 1A -1 {} {} + iso8859-13 \U0000D800 strict {} 0 {} {} + iso8859-13 \U0000DC00 tcl8 1A -1 {} {} + iso8859-13 \U0000DC00 replace 1A -1 {} {} + iso8859-13 \U0000DC00 strict {} 0 {} {} + iso8859-13 \U00010000 tcl8 1A -1 {} {} + iso8859-13 \U00010000 replace 1A -1 {} {} + iso8859-13 \U00010000 strict {} 0 {} {} + iso8859-13 \U0010FFFF tcl8 1A -1 {} {} + iso8859-13 \U0010FFFF replace 1A -1 {} {} + iso8859-13 \U0010FFFF strict {} 0 {} {} +}; # iso8859-13 + +# +# iso8859-14 (generated from glibc-ISO_8859_14-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-14 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-14 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A7 A7 00A9 A9 00AD AD 00AE AE 00B6 B6 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FF FF 010A A4 010B A5 0120 B2 0121 B3 0174 D0 0175 F0 0176 DE 0177 FE 0178 AF 1E02 A1 1E03 A2 1E0A A6 1E0B AB 1E1E B0 1E1F B1 1E40 B4 1E41 B5 1E56 B7 1E57 B9 1E60 BB 1E61 BF 1E6A D7 1E6B F7 1E80 A8 1E81 B8 1E82 AA 1E83 BA 1E84 BD 1E85 BE 1EF2 AC 1EF3 BC} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-14 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-14 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A3 A3 00A7 A7 00A9 A9 00AD AD 00AE AE 00B6 B6 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FF FF 010A A4 010B A5 0120 B2 0121 B3 0174 D0 0175 F0 0176 DE 0177 FE 0178 AF 1E02 A1 1E03 A2 1E0A A6 1E0B AB 1E1E B0 1E1F B1 1E40 B4 1E41 B5 1E56 B7 1E57 B9 1E60 BB 1E61 BF 1E6A D7 1E6B F7 1E80 A8 1E81 B8 1E82 AA 1E83 BA 1E84 BD 1E85 BE 1EF2 AC 1EF3 BC} +} -result {} + +# iso8859-14 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-14 + +# iso8859-14 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-14 \U000000A1 tcl8 1A -1 {} {} + iso8859-14 \U000000A1 replace 1A -1 {} {} + iso8859-14 \U000000A1 strict {} 0 {} {} + iso8859-14 \U00000400 tcl8 1A -1 {} {} + iso8859-14 \U00000400 replace 1A -1 {} {} + iso8859-14 \U00000400 strict {} 0 {} {} + iso8859-14 \U0000D800 tcl8 1A -1 {} {} + iso8859-14 \U0000D800 replace 1A -1 {} {} + iso8859-14 \U0000D800 strict {} 0 {} {} + iso8859-14 \U0000DC00 tcl8 1A -1 {} {} + iso8859-14 \U0000DC00 replace 1A -1 {} {} + iso8859-14 \U0000DC00 strict {} 0 {} {} + iso8859-14 \U00010000 tcl8 1A -1 {} {} + iso8859-14 \U00010000 replace 1A -1 {} {} + iso8859-14 \U00010000 strict {} 0 {} {} + iso8859-14 \U0010FFFF tcl8 1A -1 {} {} + iso8859-14 \U0010FFFF replace 1A -1 {} {} + iso8859-14 \U0010FFFF strict {} 0 {} {} +}; # iso8859-14 + +# +# iso8859-15 (generated from glibc-ISO_8859_15-2.1.2) + +test encoding-convertfrom-ucmCompare-iso8859-15 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-15 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A5 A5 00A7 A7 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00B9 B9 00BA BA 00BB BB 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF 0152 BC 0153 BD 0160 A6 0161 A8 0178 BE 017D B4 017E B8 20AC A4} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-15 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-15 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A1 A1 00A2 A2 00A3 A3 00A5 A5 00A7 A7 00A9 A9 00AA AA 00AB AB 00AC AC 00AD AD 00AE AE 00AF AF 00B0 B0 00B1 B1 00B2 B2 00B3 B3 00B5 B5 00B6 B6 00B7 B7 00B9 B9 00BA BA 00BB BB 00BF BF 00C0 C0 00C1 C1 00C2 C2 00C3 C3 00C4 C4 00C5 C5 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D0 D0 00D1 D1 00D2 D2 00D3 D3 00D4 D4 00D5 D5 00D6 D6 00D7 D7 00D8 D8 00D9 D9 00DA DA 00DB DB 00DC DC 00DD DD 00DE DE 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E3 E3 00E4 E4 00E5 E5 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F0 F0 00F1 F1 00F2 F2 00F3 F3 00F4 F4 00F5 F5 00F6 F6 00F7 F7 00F8 F8 00F9 F9 00FA FA 00FB FB 00FC FC 00FD FD 00FE FE 00FF FF 0152 BC 0153 BD 0160 A6 0161 A8 0178 BE 017D B4 017E B8 20AC A4} +} -result {} + +# iso8859-15 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-15 + +# iso8859-15 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-15 \U000000A4 tcl8 1A -1 {} {} + iso8859-15 \U000000A4 replace 1A -1 {} {} + iso8859-15 \U000000A4 strict {} 0 {} {} + iso8859-15 \U00000400 tcl8 1A -1 {} {} + iso8859-15 \U00000400 replace 1A -1 {} {} + iso8859-15 \U00000400 strict {} 0 {} {} + iso8859-15 \U0000D800 tcl8 1A -1 {} {} + iso8859-15 \U0000D800 replace 1A -1 {} {} + iso8859-15 \U0000D800 strict {} 0 {} {} + iso8859-15 \U0000DC00 tcl8 1A -1 {} {} + iso8859-15 \U0000DC00 replace 1A -1 {} {} + iso8859-15 \U0000DC00 strict {} 0 {} {} + iso8859-15 \U00010000 tcl8 1A -1 {} {} + iso8859-15 \U00010000 replace 1A -1 {} {} + iso8859-15 \U00010000 strict {} 0 {} {} + iso8859-15 \U0010FFFF tcl8 1A -1 {} {} + iso8859-15 \U0010FFFF replace 1A -1 {} {} + iso8859-15 \U0010FFFF strict {} 0 {} {} +}; # iso8859-15 + +# +# iso8859-16 (generated from glibc-ISO_8859_16-2.3.3) + +test encoding-convertfrom-ucmCompare-iso8859-16 {Compare against ICU UCM} -body { + ucmConvertfromMismatches iso8859-16 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 A7 00A9 A9 00AB AB 00AD AD 00B0 B0 00B1 B1 00B6 B6 00B7 B7 00BB BB 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D2 D2 00D3 D3 00D4 D4 00D6 D6 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F2 F2 00F3 F3 00F4 F4 00F6 F6 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 0102 C3 0103 E3 0104 A1 0105 A2 0106 C5 0107 E5 010C B2 010D B9 0110 D0 0111 F0 0118 DD 0119 FD 0141 A3 0142 B3 0143 D1 0144 F1 0150 D5 0151 F5 0152 BC 0153 BD 015A D7 015B F7 0160 A6 0161 A8 0170 D8 0171 F8 0178 BE 0179 AC 017A AE 017B AF 017C BF 017D B4 017E B8 0218 AA 0219 BA 021A DE 021B FE 201D B5 201E A5 20AC A4} +} -result {} + +test encoding-convertto-ucmCompare-iso8859-16 {Compare against ICU UCM} -body { + ucmConverttoMismatches iso8859-16 {0000 00 0001 01 0002 02 0003 03 0004 04 0005 05 0006 06 0007 07 0008 08 0009 09 000A 0A 000B 0B 000C 0C 000D 0D 000E 0E 000F 0F 0010 10 0011 11 0012 12 0013 13 0014 14 0015 15 0016 16 0017 17 0018 18 0019 19 001A 1A 001B 1B 001C 1C 001D 1D 001E 1E 001F 1F 0020 20 0021 21 0022 22 0023 23 0024 24 0025 25 0026 26 0027 27 0028 28 0029 29 002A 2A 002B 2B 002C 2C 002D 2D 002E 2E 002F 2F 0030 30 0031 31 0032 32 0033 33 0034 34 0035 35 0036 36 0037 37 0038 38 0039 39 003A 3A 003B 3B 003C 3C 003D 3D 003E 3E 003F 3F 0040 40 0041 41 0042 42 0043 43 0044 44 0045 45 0046 46 0047 47 0048 48 0049 49 004A 4A 004B 4B 004C 4C 004D 4D 004E 4E 004F 4F 0050 50 0051 51 0052 52 0053 53 0054 54 0055 55 0056 56 0057 57 0058 58 0059 59 005A 5A 005B 5B 005C 5C 005D 5D 005E 5E 005F 5F 0060 60 0061 61 0062 62 0063 63 0064 64 0065 65 0066 66 0067 67 0068 68 0069 69 006A 6A 006B 6B 006C 6C 006D 6D 006E 6E 006F 6F 0070 70 0071 71 0072 72 0073 73 0074 74 0075 75 0076 76 0077 77 0078 78 0079 79 007A 7A 007B 7B 007C 7C 007D 7D 007E 7E 007F 7F 0080 80 0081 81 0082 82 0083 83 0084 84 0085 85 0086 86 0087 87 0088 88 0089 89 008A 8A 008B 8B 008C 8C 008D 8D 008E 8E 008F 8F 0090 90 0091 91 0092 92 0093 93 0094 94 0095 95 0096 96 0097 97 0098 98 0099 99 009A 9A 009B 9B 009C 9C 009D 9D 009E 9E 009F 9F 00A0 A0 00A7 A7 00A9 A9 00AB AB 00AD AD 00B0 B0 00B1 B1 00B6 B6 00B7 B7 00BB BB 00C0 C0 00C1 C1 00C2 C2 00C4 C4 00C6 C6 00C7 C7 00C8 C8 00C9 C9 00CA CA 00CB CB 00CC CC 00CD CD 00CE CE 00CF CF 00D2 D2 00D3 D3 00D4 D4 00D6 D6 00D9 D9 00DA DA 00DB DB 00DC DC 00DF DF 00E0 E0 00E1 E1 00E2 E2 00E4 E4 00E6 E6 00E7 E7 00E8 E8 00E9 E9 00EA EA 00EB EB 00EC EC 00ED ED 00EE EE 00EF EF 00F2 F2 00F3 F3 00F4 F4 00F6 F6 00F9 F9 00FA FA 00FB FB 00FC FC 00FF FF 0102 C3 0103 E3 0104 A1 0105 A2 0106 C5 0107 E5 010C B2 010D B9 0110 D0 0111 F0 0118 DD 0119 FD 0141 A3 0142 B3 0143 D1 0144 F1 0150 D5 0151 F5 0152 BC 0153 BD 015A D7 015B F7 0160 A6 0161 A8 0170 D8 0171 F8 0178 BE 0179 AC 017A AE 017B AF 017C BF 017D B4 017E B8 0218 AA 0219 BA 021A DE 021B FE 201D B5 201E A5 20AC A4} +} -result {} + +# iso8859-16 - invalid byte sequences +lappend encInvalidBytes {*}{ +}; # iso8859-16 + +# iso8859-16 - invalid byte sequences +lappend encUnencodableStrings {*}{ + iso8859-16 \U000000A1 tcl8 1A -1 {} {} + iso8859-16 \U000000A1 replace 1A -1 {} {} + iso8859-16 \U000000A1 strict {} 0 {} {} + iso8859-16 \U00000400 tcl8 1A -1 {} {} + iso8859-16 \U00000400 replace 1A -1 {} {} + iso8859-16 \U00000400 strict {} 0 {} {} + iso8859-16 \U0000D800 tcl8 1A -1 {} {} + iso8859-16 \U0000D800 replace 1A -1 {} {} + iso8859-16 \U0000D800 strict {} 0 {} {} + iso8859-16 \U0000DC00 tcl8 1A -1 {} {} + iso8859-16 \U0000DC00 replace 1A -1 {} {} + iso8859-16 \U0000DC00 strict {} 0 {} {} + iso8859-16 \U00010000 tcl8 1A -1 {} {} + iso8859-16 \U00010000 replace 1A -1 {} {} + iso8859-16 \U00010000 strict {} 0 {} {} + iso8859-16 \U0010FFFF tcl8 1A -1 {} {} + iso8859-16 \U0010FFFF replace 1A -1 {} {} + iso8859-16 \U0010FFFF strict {} 0 {} {} +}; # iso8859-16 diff --git a/tests/indexObj.test b/tests/indexObj.test index f10bd2a..2c50200 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -1,4 +1,4 @@ -# This file is a Tcl script to test out the the procedures in file +# This file is a Tcl script to test out the procedures in file # tkIndexObj.c, which implement indexed table lookups. The tests here are # organized in the standard fashion for Tcl tests. # diff --git a/tests/info.test b/tests/info.test index c17588f..ef41bdf 100644 --- a/tests/info.test +++ b/tests/info.test @@ -20,7 +20,7 @@ if {{::tcltest} ni [namespace children]} { namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] catch [list package require -exact tcl::test [info patchlevel]] testConstraint zlib [llength [info commands zlib]] # Set up namespaces needed to test operation of "info args", "info body", diff --git a/tests/internals.tcl b/tests/internals.tcl index ff6c42b..36dbc90 100644 --- a/tests/internals.tcl +++ b/tests/internals.tcl @@ -36,7 +36,7 @@ proc testWithLimit args { # with limited address space: if {[info exists in(-addmem)] || [info exists in(-maxmem)]} { if {[info exists in(-addmem)]} { - # as differnce to normal usage, so try to retrieve current memory usage: + # as difference to normal usage, so try to retrieve current memory usage: if {[catch { # using ps (vsz is in KB): incr in(-addmem) [expr {[lindex [exec ps -hq $ppid -o vsz] end] * 1024}] diff --git a/tests/io.test b/tests/io.test index 96abadd..1efd69c 100644 --- a/tests/io.test +++ b/tests/io.test @@ -13,12 +13,12 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -namespace eval ::tcl::test::io { +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.5 +} - if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 - namespace import -force ::tcltest::* - } +namespace eval ::tcl::test::io { + namespace import ::tcltest::* variable umaskValue variable path @@ -34,7 +34,7 @@ namespace eval ::tcl::test::io { package require -exact tcl::test [info patchlevel] set ::tcltestlib [info loaded {} Tcltest] } - package require tcltests + source [file join [file dirname [info script]] tcltests.tcl] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] @@ -48,6 +48,8 @@ testConstraint testservicemode [llength [info commands testservicemode]] testConstraint notWinCI [expr { $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}] testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] +# File permissions broken on wsl without some "exotic" wsl configuration +testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] # You need a *very* special environment to do some tests. In # particular, many file systems do not support large-files... @@ -77,7 +79,7 @@ set path(cat) [makeFile { if {$argv != ""} { set f [open [lindex $argv 0]] } - fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A + fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar "\x1A \x1A" fconfigure stdout -encoding binary -translation lf -buffering none fileevent $f readable "foo $f" proc foo {f} { @@ -108,7 +110,7 @@ set path(test1) [makeFile {} test1] test io-1.6 {Tcl_WriteChars: WriteBytes} { set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f "a乍\x00" + puts -nonewline $f "a\x4D\x00" close $f contents $path(test1) } "a\x4D\x00" @@ -272,7 +274,7 @@ test io-3.4 {WriteChars: loop over stage buffer} -body { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 16 + fconfigure $f -encoding jis0208 -buffersize 16 -profile tcl8 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -286,7 +288,7 @@ test io-3.5 {WriteChars: saved != 0} -body { # requested buffersize. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 17 + fconfigure $f -encoding jis0208 -buffersize 17 -profile tcl8 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -319,7 +321,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body { # of the next channel buffer. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 17 + fconfigure $f -encoding jis0208 -buffersize 17 -profile tcl8 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -466,7 +468,7 @@ test io-6.3 {Tcl_GetsObj: how many have we used?} { test io-6.4 {Tcl_GetsObj: encoding == NULL} { set f [open $path(test1) w] fconfigure $f -translation binary - puts $f "\x81\u1234\x00" + puts $f "\x81\x34\x00" close $f set f [open $path(test1)] fconfigure $f -translation binary @@ -517,7 +519,7 @@ test io-6.8 {Tcl_GetsObj: remember if EOF is seen} { puts $f "abcdef\x1Aghijk\nwombat" close $f set f [open $path(test1)] - fconfigure $f -eofchar \x1A + fconfigure $f -eofchar "\x1A \x1A" set x [list [gets $f line] $line [gets $f line] $line] close $f set x @@ -527,7 +529,7 @@ test io-6.9 {Tcl_GetsObj: remember if EOF is seen} { puts $f "abcdefghijk\nwom\x1Abat" close $f set f [open $path(test1)] - fconfigure $f -eofchar \x1A + fconfigure $f -eofchar "\x1A \x1A" set x [list [gets $f line] $line [gets $f line] $line] close $f set x @@ -1036,7 +1038,7 @@ test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { puts -nonewline $f "123456\x1Ak9012345\r" close $f set f [open $path(test1)] - fconfigure $f -eofchar \x1A + fconfigure $f -eofchar "\x1A \x1A" set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]] close $f set x @@ -3382,7 +3384,7 @@ test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} { puts -nonewline $f hello\nthere\nand\rhere\n\x1A close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set c [read $f] close $f set c @@ -3394,11 +3396,11 @@ here test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set c [read $f] close $f set c @@ -3415,7 +3417,7 @@ test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -3435,7 +3437,7 @@ test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -3513,7 +3515,7 @@ test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set c [string length [read $f]] set e [eof $f] close $f @@ -3527,7 +3529,7 @@ test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" set c [string length [read $f]] set e [eof $f] close $f @@ -3541,7 +3543,7 @@ test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set c [string length [read $f]] set e [eof $f] close $f @@ -3555,7 +3557,7 @@ test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" set c [string length [read $f]] set e [eof $f] close $f @@ -3569,7 +3571,7 @@ test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set c [string length [read $f]] set e [eof $f] close $f @@ -3583,7 +3585,7 @@ test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" set c [string length [read $f]] set e [eof $f] close $f @@ -3831,7 +3833,7 @@ test io-31.13 {binary mode is synonym of lf mode} { } lf # # Test io-9.14 has been removed because "auto" output translation mode is -# not supoprted. +# not supported. # test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} { file delete $path(test1) @@ -3916,7 +3918,7 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -3931,11 +3933,11 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -3955,7 +3957,7 @@ test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -3973,7 +3975,7 @@ test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -4057,7 +4059,7 @@ test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -4075,7 +4077,7 @@ test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -4093,7 +4095,7 @@ test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -4111,7 +4113,7 @@ test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -4129,7 +4131,7 @@ test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -4147,7 +4149,7 @@ test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" set l "" lappend l [gets $f] lappend l [gets $f] @@ -5028,12 +5030,12 @@ test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio { test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5042,12 +5044,12 @@ test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { test io-35.7 {Tcl_Eof, eof char, lf write, lf read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5056,12 +5058,12 @@ test io-35.7 {Tcl_Eof, eof char, lf write, lf read} { test io-35.8 {Tcl_Eof, eof char, cr write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5070,12 +5072,12 @@ test io-35.8 {Tcl_Eof, eof char, cr write, auto read} { test io-35.9 {Tcl_Eof, eof char, cr write, cr read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5084,12 +5086,12 @@ test io-35.9 {Tcl_Eof, eof char, cr write, cr read} { test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5098,12 +5100,12 @@ test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} { test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5118,7 +5120,7 @@ test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5133,7 +5135,7 @@ test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5148,7 +5150,7 @@ test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5163,7 +5165,7 @@ test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5178,7 +5180,7 @@ test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5193,7 +5195,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" set l [string length [read $f]] set e [eof $f] close $f @@ -5216,12 +5218,12 @@ test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body { test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5230,12 +5232,12 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body { test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" puts $f {} close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5264,7 +5266,7 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5279,7 +5281,7 @@ test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5474,7 +5476,7 @@ test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed set chan [open [info script] r] - fconfigure $chan -buffersize 10 + fconfigure $chan -buffersize 10 -encoding utf-8 set var [read $chan 2] fconfigure $chan -buffersize 32 append var [read $chan] @@ -5675,13 +5677,20 @@ test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} { close $f set x } 牦 -test io-39.16 {Tcl_SetChannelOption: -encoding, errors} { +test io-39.16 {Tcl_SetChannelOption: -encoding (shortened to "-en"), errors} -body { + file delete $path(test1) + set f [open $path(test1) w] + fconfigure $f -en foobar +} -cleanup { + close $f +} -returnCodes 1 -result {unknown encoding "foobar"} +test io-39.16a {Tcl_SetChannelOption: -encoding (invalid shortening to "-e"), errors} -body { file delete $path(test1) set f [open $path(test1) w] - set result [list [catch {fconfigure $f -encoding foobar} msg] $msg] + fconfigure $f -e foobar +} -cleanup { close $f - set result -} {1 {unknown encoding "foobar"}} +} -returnCodes 1 -match glob -result {bad option "-e": should be one of *} test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} { set f [open "|[list [interpreter] $path(cat)]" r+] fconfigure $f -encoding binary @@ -5763,7 +5772,7 @@ test io-39.22 {Tcl_SetChannelOption, invariance} {unix} { lappend l [fconfigure $f1 -eofchar] fconfigure $f1 -eofchar {ON GO} lappend l [fconfigure $f1 -eofchar] - fconfigure $f1 -eofchar D + fconfigure $f1 -eofchar {D D} lappend l [fconfigure $f1 -eofchar] close $f1 set l @@ -5774,14 +5783,14 @@ test io-39.22a {Tcl_SetChannelOption, invariance} { set l [list] fconfigure $f1 -eofchar {ON GO} lappend l [fconfigure $f1 -eofchar] - fconfigure $f1 -eofchar D + fconfigure $f1 -eofchar {D D} lappend l [fconfigure $f1 -eofchar] lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg] close $f1 set l } {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} test io-39.23 {Tcl_GetChannelOption, server socket is not readable or - writeable, it should still have valid -eofchar and -translation options } { + writable, it should still have valid -eofchar and -translation options } { set l [list] set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] @@ -5813,7 +5822,7 @@ test io-40.1 {POSIX open access modes: RDWR} { close $f set x } {zzy abzzy} -test io-40.2 {POSIX open access modes: CREAT} {unix} { +test io-40.2 {POSIX open access modes: CREAT} {unix notWsl} { file delete $path(test3) set f [open $path(test3) {WRONLY CREAT} 0o600] file stat $path(test3) stats @@ -5825,7 +5834,7 @@ test io-40.2 {POSIX open access modes: CREAT} {unix} { close $f set x } {0o600 {line 1}} -test io-40.3 {POSIX open access modes: CREAT} {unix umask} { +test io-40.3 {POSIX open access modes: CREAT} {unix umask notWsl} { # This test only works if your umask is 2, like ouster's. file delete $path(test3) set f [open $path(test3) {WRONLY CREAT}] @@ -6539,7 +6548,7 @@ test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6567,7 +6576,7 @@ test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {file set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6595,7 +6604,7 @@ test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6623,7 +6632,7 @@ test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {file set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6651,7 +6660,7 @@ test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} { set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6679,7 +6688,7 @@ test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar \x1A + fconfigure $f -translation auto -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6707,7 +6716,7 @@ test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6735,7 +6744,7 @@ test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fil set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar \x1A + fconfigure $f -translation lf -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6763,7 +6772,7 @@ test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6791,7 +6800,7 @@ test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fil set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar \x1A + fconfigure $f -translation cr -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6819,7 +6828,7 @@ test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {f set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6847,7 +6856,7 @@ test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar \x1A + fconfigure $f -translation crlf -eofchar "\x1A \x1A" fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -7239,8 +7248,8 @@ test io-52.3 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -blocking 0 - fconfigure $f2 -translation cr -blocking 0 + fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0 set s0 [fcopy $f1 $f2] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7280,8 +7289,8 @@ test io-52.5 {TclCopyChannel, all} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -blocking 0 - fconfigure $f2 -translation lf -blocking 0 + fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified. set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7297,8 +7306,8 @@ test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -blocking 0 - fconfigure $f2 -translation lf -blocking 0 + fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7314,8 +7323,8 @@ test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -blocking 0 - fconfigure $f2 -translation lf -blocking 0 + fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7331,8 +7340,8 @@ test io-52.6 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -blocking 0 - fconfigure $f2 -translation lf -blocking 0 + fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7348,8 +7357,8 @@ test io-52.7 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -blocking 0 - fconfigure $f2 -translation lf -blocking 0 + fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 fcopy $f1 $f2 set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] set s1 [file size $thisScript] @@ -7426,7 +7435,7 @@ test io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} -test io-52.10 {TclCopyChannel & encodings} {fcopy} { +test io-52.10 {TclCopyChannel & encodings} {fcopy notWinCI} { # encoding to binary (=> implies that the # internal utf-8 is written) @@ -7609,6 +7618,103 @@ test io-52.19 {coverage of eofChar handling} { close $out file size $path(test2) } 8 +test io-52.20 {TclCopyChannel & encodings} -setup { + set out [open $path(utf8-fcopy.txt) w] + fconfigure $out -encoding utf-8 -translation lf + puts $out "Á" + close $out +} -constraints {fcopy} -body { + # binary to encoding => the input has to be + # in utf-8 to make sense to the encoder + + set in [open $path(utf8-fcopy.txt) r] + set out [open $path(kyrillic.txt) w] + + # Using "-encoding ascii" means reading the "Á" gives an error + fconfigure $in -encoding ascii -profile strict + fconfigure $out -encoding koi8-r -translation lf + + fcopy $in $out +} -cleanup { + close $in + close $out +} -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character} +test io-52.21 {TclCopyChannel & encodings} -setup { + set out [open $path(utf8-fcopy.txt) w] + fconfigure $out -encoding utf-8 -translation lf + puts $out "Á" + close $out +} -constraints {fcopy} -body { + # binary to encoding => the input has to be + # in utf-8 to make sense to the encoder + + set in [open $path(utf8-fcopy.txt) r] + set out [open $path(kyrillic.txt) w] + + # Using "-encoding ascii" means writing the "Á" gives an error + fconfigure $in -encoding utf-8 + fconfigure $out -encoding ascii -translation lf -profile strict + + fcopy $in $out +} -cleanup { + close $in + close $out +} -returnCodes 1 -match glob -result {error writing "file*": invalid or incomplete multibyte or wide character} +test io-52.22 {TclCopyChannel & encodings} -setup { + set out [open $path(utf8-fcopy.txt) w] + fconfigure $out -encoding utf-8 -translation lf + puts $out "Á" + close $out +} -constraints {fcopy} -body { + # binary to encoding => the input has to be + # in utf-8 to make sense to the encoder + + set in [open $path(utf8-fcopy.txt) r] + set out [open $path(kyrillic.txt) w] + + # Using "-encoding ascii" means reading the "Á" gives an error + fconfigure $in -encoding ascii -profile strict + fconfigure $out -encoding koi8-r -translation lf + proc ::xxx args { + set ::s0 $args + } + + fcopy $in $out -command ::xxx + vwait ::s0 + set ::s0 +} -cleanup { + close $in + close $out + unset ::s0 +} -match glob -result {0 {error reading "file*": invalid or incomplete multibyte or wide character}} +test io-52.23 {TclCopyChannel & encodings} -setup { + set out [open $path(utf8-fcopy.txt) w] + fconfigure $out -encoding utf-8 -translation lf + puts $out "Á" + close $out +} -constraints {fcopy} -body { + # binary to encoding => the input has to be + # in utf-8 to make sense to the encoder + + set in [open $path(utf8-fcopy.txt) r] + set out [open $path(kyrillic.txt) w] + + # Using "-encoding ascii" means writing the "Á" gives an error + fconfigure $in -encoding utf-8 + fconfigure $out -encoding ascii -translation lf -profile strict + proc ::xxx args { + set ::s0 $args + } + + fcopy $in $out -command ::xxx + vwait ::s0 + set ::s0 +} -cleanup { + close $in + close $out + unset ::s0 +} -match glob -result {0 {error writing "file*": invalid or incomplete multibyte or wide character}} + test io-53.1 {CopyData} {fcopy} { file delete $path(test1) @@ -7626,8 +7732,8 @@ test io-53.2 {CopyData} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -blocking 0 - fconfigure $f2 -translation cr -blocking 0 + fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0 fcopy $f1 $f2 -command [namespace code {set s0}] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] variable s0 @@ -8105,7 +8211,7 @@ test io-53.11 {Bug 2895565} -setup { removeFile out removeFile in } -result {40 bytes copied} -test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} { +test io-53.12.0 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} { file delete $path(pipe) set f1 [open $path(pipe) w] puts -nonewline $f1 { @@ -8124,6 +8230,32 @@ test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fc close $f1 list $::done $ch } {ok A} +test io-53.12.1 { + Issue 9ca87e6286262a62. + CopyData: foreground short reads via ReadChars(). + Related to report 3096275 for ReadBytes(). + + Prior to the fix this test waited forever for read() to return. +} {stdio unix fcopy} { + file delete $path(output) + set f1 [open $path(output) w] + puts -nonewline $f1 { + chan configure stdin -encoding iso8859-1 -translation lf -buffering none + fcopy stdin stdout + } + close $f1 + set f1 [open "|[list [info nameofexecutable] $path(output)]" r+] + try { + chan configure $f1 -encoding utf-8 -buffering none + puts -nonewline $f1 A + set ch [read $f1 1] + } finally { + if {$f1 in [chan names]} { + close $f1 + } + } + lindex $ch +} A test io-53.13 {TclCopyChannel: read error reporting} -setup { proc driver {cmd args} { variable buffer @@ -8590,7 +8722,7 @@ test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} { # cut of the remainder of the error stack, especially the filename set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]] list $x $result -} {1 {gets ABC catch {error writing "stdout": illegal byte sequence}}} +} {1 {gets ABC catch {error writing "stdout": invalid or incomplete multibyte or wide character}}} test io-61.1 {Reset eof state after changing the eof char} -setup { set datafile [makeFile {} eofchar] @@ -8620,7 +8752,7 @@ test io-61.1 {Reset eof state after changing the eof char} -setup { } -result {77 = 23431} -# Test the cutting and splicing of channels, this is incidentially the +# Test the cutting and splicing of channels, this is incidentally the # attach/detach facility of package Thread, but __without any # safeguards__. It can also be used to emulate transfer of channels # between threads, and is used for that here. @@ -8924,7 +9056,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup { read $rfd } -body { set result [eof $rfd] - puts -nonewline $wfd "more\xC2\xA0data" + puts -nonewline $wfd more\xC2\xA0data lappend result [eof $rfd] lappend result [read $rfd] lappend result [eof $rfd] @@ -8955,16 +9087,16 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup { # The following tests 75.1 to 75.5 exercise strict or tolerant channel # encoding. # TCL 8.7 only offers tolerant channel encoding, what is tested here. -test io-75.1 {multibyte encoding error read results in raw bytes} -constraints deprecated -setup { +test io-75.1 {multibyte encoding error read results in raw bytes} -setup { set fn [makeFile {} io-75.1] set f [open $fn w+] fconfigure $f -encoding binary # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed # by a byte > 0x7F. This is violated to get an invalid sequence. - puts -nonewline $f "A\xC0\x40" + puts -nonewline $f A\xC0\x40 flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none + fconfigure $f -encoding utf-8 -profile tcl8 -buffering none } -body { set d [read $f] binary scan $d H* hd @@ -8972,87 +9104,234 @@ test io-75.1 {multibyte encoding error read results in raw bytes} -constraints d } -cleanup { close $f removeFile io-75.1 -} -result "41c040" +} -result 41c040 -test io-75.2 {unrepresentable character write passes and is replaced by ?} -constraints deprecated -setup { +test io-75.2 {unrepresentable character write passes and is replaced by ? (-profile tcl8)} -setup { set fn [makeFile {} io-75.2] set f [open $fn w+] - fconfigure $f -encoding iso8859-1 + fconfigure $f -encoding iso8859-1 -profile tcl8 } -body { - puts -nonewline $f "A\u2022" + puts -nonewline $f A\u2022 flush $f seek $f 0 read $f } -cleanup { close $f removeFile io-75.2 -} -result "A?" +} -result A? # Incomplete sequence test. # This error may IMHO only be detected with the close. # But the read already returns the incomplete sequence. -test io-75.3 {incomplete multibyte encoding read is ignored} -setup { +test io-75.3 {incomplete multibyte encoding read is ignored (-profile tcl8)} -setup { set fn [makeFile {} io-75.3] set f [open $fn w+] fconfigure $f -encoding binary puts -nonewline $f "A\xC0" flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none + fconfigure $f -encoding utf-8 -buffering none -profile tcl8 } -body { set d [read $f] - close $f binary scan $d H* hd set hd } -cleanup { + close $f removeFile io-75.3 -} -result "41c0" +} -result 41c0 # As utf-8 has a special treatment in multi-byte decoding, also test another # one. -test io-75.4 {shiftjis encoding error read results in raw bytes} -setup { +test io-75.4 {shiftjis encoding error read results in raw bytes (-profile tcl8)} -setup { set fn [makeFile {} io-75.4] set f [open $fn w+] fconfigure $f -encoding binary # In shiftjis, \x81 starts a two-byte sequence. # But 2nd byte \xFF is not allowed - puts -nonewline $f "A\x81\xFFA" + puts -nonewline $f A\x81\xFFA flush $f seek $f 0 - fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -} -constraints deprecated -body { + fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -profile tcl8 +} -body { set d [read $f] binary scan $d H* hd set hd } -cleanup { close $f removeFile io-75.4 -} -result "4181ff41" +} -result 4181ff41 -test io-75.5 {incomplete shiftjis encoding read is ignored} -setup { +test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup { set fn [makeFile {} io-75.5] set f [open $fn w+] fconfigure $f -encoding binary - # \x81 announces a two byte sequence. - puts -nonewline $f "A\x81" + puts -nonewline $f A\x81 flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile tcl8 } -body { set d [read $f] - close $f binary scan $d H* hd set hd } -cleanup { + close $f removeFile io-75.5 -} -result "4181" +} -result 4181 + +test io-75.6 {invalid utf-8 encoding gets is not ignored (-profile strict)} -setup { + set fn [makeFile {} io-75.6] + set f [open $fn w+] + fconfigure $f -encoding binary + # \x81 is invalid in utf-8 + puts -nonewline $f A\x81 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile strict +} -body { + gets $f +} -cleanup { + close $f + removeFile io-75.6 +} -match glob -returnCodes 1 -result {error reading "*": invalid or incomplete multibyte or wide character} + +test io-75.7 {invalid utf-8 encoding gets is not ignored (-profile strict)} -setup { + set fn [makeFile {} io-75.7] + set f [open $fn w+] + fconfigure $f -encoding binary + # \x81 is invalid in utf-8 + puts -nonewline $f A\x81 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile strict +} -body { + read $f +} -cleanup { + close $f + removeFile io-75.7 +} -match glob -returnCodes 1 -result {error reading "*": invalid or incomplete multibyte or wide character} + +test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup { + set fn [makeFile {} io-75.8] + set f [open $fn w+] + fconfigure $f -encoding binary + # \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes precedence. + puts -nonewline $f A\x1A\x81 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A -translation lf -profile strict +} -body { + set d [read $f] + binary scan $d H* hd + lappend hd [eof $f] + lappend hd [read $f] + close $f + set hd +} -cleanup { + removeFile io-75.8 +} -result {41 1 {}} + +test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup { + set fn [makeFile {} io-75.9] + set f [open $fn w+] + fconfigure $f -encoding iso8859-1 -profile strict +} -body { + catch {puts -nonewline $f "A\u2022"} msg + flush $f + seek $f 0 + list [read $f] $msg +} -cleanup { + close $f + removeFile io-75.9 +} -match glob -result [list {A} {error writing "*": invalid or incomplete multibyte or wide character}] + +# Incomplete sequence test. +# This error may IMHO only be detected with the close. +# But the read already returns the incomplete sequence. +test io-75.10 {incomplete multibyte encoding read is ignored} -setup { + set fn [makeFile {} io-75.10] + set f [open $fn w+] + fconfigure $f -encoding binary + puts -nonewline $f A\xC0 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none +} -body { + set d [read $f] + binary scan $d H* hd + set hd +} -cleanup { + close $f + removeFile io-75.10 +} -result 41c0 +# The current result returns the orphan byte as byte. +# This may be expected due to special utf-8 handling. + +# As utf-8 has a special treatment in multi-byte decoding, also test another +# one. +test io-75.11 {shiftjis encoding error read results in raw bytes} -setup { + set fn [makeFile {} io-75.11] + set f [open $fn w+] + fconfigure $f -encoding binary + # In shiftjis, \x81 starts a two-byte sequence. + # But 2nd byte \xFF is not allowed + puts -nonewline $f A\x81\xFFA + flush $f + seek $f 0 + fconfigure $f -encoding shiftjis -blocking 0 -eofchar "" -translation lf -profile strict +} -body { + set d [read $f] + binary scan $d H* hd + lappend hd [catch {set d [read $f]} msg] + lappend hd $msg +} -cleanup { + close $f + removeFile io-75.11 +} -match glob -result {41 1 {error reading "*": invalid or incomplete multibyte or wide character}} +test io-75.12 {invalid utf-8 encoding read is ignored} -setup { + set fn [makeFile {} io-75.12] + set f [open $fn w+] + fconfigure $f -encoding binary + puts -nonewline $f A\x81 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf +} -body { + set d [read $f] + binary scan $d H* hd + set hd +} -cleanup { + close $f + removeFile io-75.12 +} -result 4181 +test io-75.13 { + In nonblocking mode when there is an encoding error the data that has been + successfully read so far is returned first and then the error is returned + on the next call to [read]. +} -setup { + set fn [makeFile {} io-75.13] + set f [open $fn w+] + fconfigure $f -encoding binary + # \x81 is invalid in utf-8 + puts -nonewline $f A\x81 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -blocking 0 -eofchar "" -translation lf -profile strict +} -body { + set d [read $f] + binary scan $d H* hd + lappend hd [catch {read $f} msg] + lappend hd $msg +} -cleanup { + close $f + removeFile io-75.13 +} -match glob -result {41 1 {error reading "*": invalid or incomplete multibyte or wide character}} # ### ### ### ######### ######### ######### -test io-75.0 {channel modes} -setup { +test io-76.0 {channel modes} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r] } -constraints testchannel -body { @@ -9062,7 +9341,7 @@ test io-75.0 {channel modes} -setup { removeFile dummy } -result {read {}} -test io-75.1 {channel modes} -setup { +test io-76.1 {channel modes} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile w] } -constraints testchannel -body { @@ -9072,7 +9351,7 @@ test io-75.1 {channel modes} -setup { removeFile dummy } -result {{} write} -test io-75.2 {channel modes} -setup { +test io-76.2 {channel modes} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { @@ -9082,7 +9361,7 @@ test io-75.2 {channel modes} -setup { removeFile dummy } -result {read write} -test io-75.3 {channel mode dropping} -setup { +test io-76.3 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r] } -constraints testchannel -body { @@ -9093,7 +9372,7 @@ test io-75.3 {channel mode dropping} -setup { removeFile dummy } -result {{read {}} {read {}}} -test io-75.4 {channel mode dropping} -setup { +test io-76.4 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r] } -constraints testchannel -body { @@ -9103,7 +9382,7 @@ test io-75.4 {channel mode dropping} -setup { removeFile dummy } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} -test io-75.5 {channel mode dropping} -setup { +test io-76.5 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile w] } -constraints testchannel -body { @@ -9114,7 +9393,7 @@ test io-75.5 {channel mode dropping} -setup { removeFile dummy } -result {{{} write} {{} write}} -test io-75.6 {channel mode dropping} -setup { +test io-76.6 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile w] } -constraints testchannel -body { @@ -9124,7 +9403,7 @@ test io-75.6 {channel mode dropping} -setup { removeFile dummy } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} -test io-75.7 {channel mode dropping} -setup { +test io-76.7 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { @@ -9135,7 +9414,7 @@ test io-75.7 {channel mode dropping} -setup { removeFile dummy } -result {{{} write} {read write}} -test io-75.8 {channel mode dropping} -setup { +test io-76.8 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { @@ -9146,7 +9425,7 @@ test io-75.8 {channel mode dropping} -setup { removeFile dummy } -result {{read {}} {read write}} -test io-75.9 {channel mode dropping} -setup { +test io-76.9 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { @@ -9157,7 +9436,7 @@ test io-75.9 {channel mode dropping} -setup { removeFile dummy } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} -test io-75.10 {channel mode dropping} -setup { +test io-76.10 {channel mode dropping} -setup { set datafile [makeFile {some characters} dummy] set f [open $datafile r+] } -constraints testchannel -body { diff --git a/tests/ioCmd.test b/tests/ioCmd.test index dbca866..e132b9a 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -17,12 +17,11 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } +source [file join [file dirname [info script]] tcltests.tcl] ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests - # Custom constraints used in this file testConstraint testchannel [llength [info commands testchannel]] @@ -208,7 +207,7 @@ test iocmd-7.5 {close command} -setup { proc expectedOpts {got extra} { set basicOpts { - -blocking -buffering -buffersize -encoding -eofchar -translation + -blocking -buffering -buffersize -encoding -eofchar -profile -translation } set opts [list {*}$basicOpts {*}$extra] lset opts end [string cat "or " [lindex $opts end]] @@ -241,33 +240,33 @@ test iocmd-8.7 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] - fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 + fconfigure $f1 -translation lf -eofchar {} -encoding utf-16 -profile tcl8 fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -translation lf} +} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf} test iocmd-8.8 {fconfigure command} -setup { file delete $path(test1) set x {} } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ - -eofchar {} -encoding utf-16 + -eofchar {} -encoding utf-16 -profile tcl8 lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] } -cleanup { catch {close $f1} -} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -translation lf}} +} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}} test iocmd-8.9 {fconfigure command} -setup { file delete $path(test1) } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation binary -buffering none -buffersize 4040 \ - -eofchar {} -encoding binary + -eofchar {} -encoding binary -profile tcl8 fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf} +} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -profile tcl8 -translation lf} test iocmd-8.10 {fconfigure command} -returnCodes error -body { fconfigure a b } -result {can not find channel named "a"} @@ -294,7 +293,7 @@ removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 -test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup { +test iocmd-8.15 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} @@ -306,7 +305,7 @@ test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOr close $srv unset cli srv port rename iocmdSRV {} -} -returnCodes error -result [expectedOpts "-blah" {-connecting -peername -sockname}] +} -returnCodes error -result [expectedOpts "-blah" {-connecting -keepalive -nodelay -peername -sockname}] test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] @@ -369,6 +368,31 @@ test iocmd-8.20 {fconfigure command / win console channel} -constraints {nonPort } -returnCodes error -result [expectedOpts "-blah" {-inputmode}] # TODO: Test parsing of serial channel options (nonPortable, since requires an # open channel to work with). +test iocmd-8.21 {fconfigure command / -nocomplainencoding 0 error} -constraints { + deprecated obsolete +} -setup { + # I don't know how else to open the console, but this is non-portable + set console stdin +} -body { + fconfigure $console -nocomplainencoding 0 +} -returnCodes error -result "bad value for -nocomplainencoding: only true allowed" +test iocmd-8.22 {fconfigure command / -nocomplainencoding 0, no error if -strictencoding already defined} -setup { + set console stdin + set oldprofile [fconfigure $console -profile] +} -constraints { + obsolete +} -body { + fconfigure $console -strictencoding 1 + fconfigure $console -nocomplainencoding 0 + fconfigure $console -nocomplainencoding +} -cleanup { + fconfigure $console -strictencoding $oldmode +} -result 0 + + +test iocmd-8.23 {fconfigure -profile badprofile} -body { + fconfigure stdin -profile froboz +} -returnCodes error -result {bad profile name "froboz": must be replace, strict, or tcl8} test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $::errorCode @@ -679,7 +703,7 @@ test iocmd-20.1 {chan, unknown method} -body { } -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *} # --- --- --- --------- --------- --------- -# chan create, and method "initalize" +# chan create, and method "initialize" test iocmd-21.0 {chan create, wrong#args, not enough} { catch {chan create} msg @@ -689,12 +713,12 @@ test iocmd-21.1 {chan create, wrong#args, too many} { catch {chan create a b c} msg set msg } {wrong # args: should be "chan create mode cmdprefix"} -test iocmd-21.2 {chan create, invalid r/w mode, empty} { - proc foo {} {} - catch {chan create {} foo} msg +test iocmd-21.2 {chan create, r/w mode empty} { + proc foo {cmd args} { return {initialize finalize watch} } + set chan [chan create {} foo] + close $chan rename foo {} - set msg -} {bad mode list: is empty} +} {} test iocmd-21.3 {chan create, invalid r/w mode, bad string} { proc foo {} {} catch {chan create {c} foo} msg @@ -1048,7 +1072,7 @@ test iocmd-23.1 {chan read, regular data return} -match glob -body { rename foo {} set res } -result {{read rc* 4096} {read rc* 4096} snarfsnarf} -test iocmd-23.2 {chan read, bad data return, to much} -match glob -body { +test iocmd-23.2 {chan read, bad data return, too much} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track @@ -1363,7 +1387,7 @@ test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { close $c rename foo {} set res -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -profile * -translation {auto *}}} test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} @@ -1372,7 +1396,7 @@ test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -profile * -translation {auto *}}} test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { @@ -1384,7 +1408,7 @@ test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -profile * -translation {auto *} -bar foo -snarf x}} test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { @@ -2359,7 +2383,7 @@ test iocmd.tf-23.1 {chan read, regular data return} -match glob -body { rename foo {} set res } -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf} -test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body { +test iocmd.tf-23.2 {chan read, bad data return, too much} -match glob -body { set res {} proc foo {args} { oninit; onfinal; track @@ -2905,7 +2929,7 @@ test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body rename foo {} set res } -constraints {testchannel thread} \ - -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} + -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *}}} test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} @@ -2918,7 +2942,7 @@ test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { rename foo {} set res } -constraints {testchannel thread} \ - -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} + -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *}}} test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { @@ -2934,7 +2958,7 @@ test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { rename foo {} set res } -constraints {testchannel thread} \ - -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} + -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *} -bar foo -snarf x}} test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { diff --git a/tests/ioTrans.test b/tests/ioTrans.test index 79493e0..45d2530 100644 --- a/tests/ioTrans.test +++ b/tests/ioTrans.test @@ -114,7 +114,7 @@ test iortrans-1.1 {chan, unknown method} -returnCodes error -body { } -match glob -result {unknown or ambiguous subcommand "foo": must be*} # --- --- --- --------- --------- --------- -# chan push, and method "initalize" +# chan push, and method "initialize" test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body { chan push @@ -634,6 +634,61 @@ test iortrans-4.9 {chan read, gets, bug 2921116} -setup { } } + + +namespace eval reflector { + proc initialize {_ chan mode} { + return {initialize finalize watch read} + } + + + proc finalize {_ chan} { + foreach id [after info] { + after cancel $id + } + namespace delete $_ + } + + + proc read {_ chan count} { + namespace upvar $_ source source + set res [string range $source 0 $count-1] + set source [string range $source $count end] + return $res + } + + + proc watch {_ chan events} { + after 0 [list chan postevent $chan read] + return read + } + + namespace ensemble create -parameters _ + namespace export * +} + + + + +namespace eval inputfilter { + proc initialize {chan mode} { + return {initialize finalize read} + } + + proc read {chan buffer} { + return $buffer + } + + proc finalize chan { + namespace delete $chan + } + + namespace ensemble create + namespace export * +} + + + # Channel read transform that is just the identity - pass all through proc idxform {cmd handle args} { switch -- $cmd { @@ -1279,7 +1334,7 @@ test iortrans-11.2 {delete interp of reflected transform} -setup { # ### ### ### ######### ######### ######### ## Helper command. Runs a script in a separate thread and returns the result. -## A channel is transfered into the thread as well, and a list of configuation +## A channel is transferred into the thread as well, and a list of configuration ## variables proc inthread {chan script args} { @@ -1958,7 +2013,7 @@ test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup { # The close flushes again, this modifies the file! lappend notes | [close $c] | # NOTE: The flush generated by the close is recorded immediately, the - # other note's here are defered until after the thread is done. This + # other note's here are deferred until after the thread is done. This # changes the order of the result a bit from the non-threaded case # (The first | moves one to the right). This is an artifact of the # 'inthread' framework, not of the transformation itself. @@ -2089,7 +2144,39 @@ test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} thread::release $tidb } -result {Owner lost} -# ### ### ### ######### ######### ######### + +test iortrans-ea69b0258a9833cb { + Crash when using a channel transformation on TCP client socket + + "line two" does not make it into result. This issue should probably be + addressed, but it is outside the scope of this test. +} -setup { + set res {} + set read 0 +} -body { + namespace eval reflector1 { + variable source "line one\nline two" + interp alias {} [namespace current]::dispatch {} [ + namespace parent]::reflector [namespace current] + } + set chan [chan create read [namespace which reflector1::dispatch]] + chan configure $chan -blocking 0 + chan push $chan inputfilter + chan event $chan read [list ::apply [list chan { + variable res + variable read + set gets [gets $chan] + append res $gets + incr read + } [namespace current]] $chan] + vwait [namespace current]::read + chan pop $chan + vwait [namespace current]::read + return $res +} -cleanup { + catch {unset read} + close $chan +} -result {line one} cleanupTests return diff --git a/tests/iogt.test b/tests/iogt.test index d397ccb..5692682 100644 --- a/tests/iogt.test +++ b/tests/iogt.test @@ -843,7 +843,7 @@ test iogt-6.0 {Push back} -constraints testchannel -body { # expect to get "xxx" from the transform because of unread "def" input to # transform which returns "xxx". # - # Actually the IO layer pre-read the whole file and will read "def" + # Actually the IO layer preread the whole file and will read "def" # directly from the buffer without bothering to consult the newly stacked # transformation. This is wrong. read $f 3 diff --git a/tests/link.test b/tests/link.test index eba359c..43a85fb 100644 --- a/tests/link.test +++ b/tests/link.test @@ -69,9 +69,9 @@ test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup { set long 34543 set ulong 567890 set float 1.0987654321 - set uwide 357357357357 + set uwide 12345678901234567890 concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide -} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357} +} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 12345678901234567890 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 12345678901234567890} test link-2.2 {writing bad values into variables} -setup { testlink delete } -constraints {testlink} -body { diff --git a/tests/listObj.test b/tests/listObj.test index 0b64635..0f43648 100644 --- a/tests/listObj.test +++ b/tests/listObj.test @@ -20,6 +20,7 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testobj [llength [info commands testobj]] +testConstraint memory [llength [info commands memory]] catch {unset x} test listobj-1.1 {Tcl_GetListObjType} emptyTest { @@ -210,6 +211,73 @@ test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj testobj bug3598580 } 123 +# Stolen from dict.test +proc listobjmemcheck script { + set end [lindex [split [memory info] \n] 3 3] + for {set i 0} {$i < 5} {incr i} { + uplevel 1 $script + set tmp $end + set end [lindex [split [memory info] \n] 3 3] + } + expr {$end - $tmp} +} + +test listobj-12.1 {Tcl_ListObjIndex memory leaks for native lists} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [lrepeat 1000 x] + set errorMessage [testlistobj indexmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} +test listobj-12.2 {Tcl_ListObjIndex memory leaks for native lists with spans} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [testlistrep new 1000 100 100] + set errorMessage [testlistobj indexmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} +test listobj-12.3 {Tcl_ListObjIndex memory leaks for lseq} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [lseq 1000] + set errorMessage [testlistobj indexmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} + +test listobj-13.1 {Tcl_ListObjGetElements memory leaks for native lists} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [lrepeat 1000 x] + set errorMessage [testlistobj getelementsmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} +test listobj-13.2 {Tcl_ListObjElements memory leaks for native lists with spans} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [testlistrep new 1000 100 100] + set errorMessage [testlistobj getelementsmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} +test listobj-13.3 {Tcl_ListObjElements memory leaks for lseq} -constraints { + testobj memory +} -body { + list [listobjmemcheck { + testobj set 1 [lseq 1000] + set errorMessage [testlistobj getelementsmemcheck 1] + testobj freeallvars + }] $errorMessage +} -result {0 {}} + # cleanup ::tcltest::cleanupTests return diff --git a/tests/listRep.test b/tests/listRep.test index 7883a21..02ff18f 100644 --- a/tests/listRep.test +++ b/tests/listRep.test @@ -472,7 +472,7 @@ test listrep-1.10.1 { test listrep-1.11 { Append elements to large unshared list is optimized as lappend so no free space in front - lreplace version -} -body { +} -constraints testlistrep -body { # Note $end, not end else byte code compiler short-cuts set l [lreplace [freeSpaceNone 1000] $end+1 $end+1 1000] validate $l @@ -482,7 +482,7 @@ test listrep-1.11 { test listrep-1.11.1 { Append elements to large unshared list is optimized as lappend so no free space in front - linsert version -} -body { +} -constraints testlistrep -body { # Note $end, not end else byte code compiler short-cuts set l [linsert [freeSpaceNone 1000] $end+1 1000] validate $l @@ -492,7 +492,7 @@ test listrep-1.11.1 { test listrep-1.11.2 { Append elements to large unshared list leaves no free space in front - lappend version -} -body { +} -constraints testlistrep -body { # Note $end, not end else byte code compiler short-cuts set l [freeSpaceNone 1000] lappend l 1000 1001 @@ -504,7 +504,7 @@ test listrep-1.11.2 { test listrep-1.12 { Replacement of elements at front with same number elements in unshared list is in-place - lreplace version -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $zero $one 10 11] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -513,7 +513,7 @@ test listrep-1.12 { test listrep-1.12.1 { Replacement of elements at front with same number elements in unshared list is in-place - lset version -} -body { +} -constraints testlistrep -body { set l [freeSpaceNone] lset l 0 -1 validate $l @@ -523,7 +523,7 @@ test listrep-1.12.1 { test listrep-1.13 { Replacement of elements at front with fewer elements in unshared list results in a spanned list with space only in front -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $zero $four 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -532,7 +532,7 @@ test listrep-1.13 { test listrep-1.14 { Replacement of elements at front with more elements in unshared list results in a reallocated spanned list with space at front and back -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $zero $one 10 11 12] validate $l list $l [spaceEqual $l] @@ -541,7 +541,7 @@ test listrep-1.14 { test listrep-1.15 { Replacement of elements in middle with same number elements in unshared list is in-place - lreplace version -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $one $two 10 11] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -550,7 +550,7 @@ test listrep-1.15 { test listrep-1.15.1 { Replacement of elements in middle with same number elements in unshared list is in-place - lset version -} -body { +} -constraints testlistrep -body { set l [freeSpaceNone] lset l $two -1 validate $l @@ -560,7 +560,7 @@ test listrep-1.15.1 { test listrep-1.16 { Replacement of elements in front half with fewer elements in unshared list results in a spanned list with space only in front since smaller segment moved -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $one $four 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -569,7 +569,7 @@ test listrep-1.16 { test listrep-1.17 { Replacement of elements in back half with fewer elements in unshared list results in a spanned list with space only at back -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] end-$four end-$one 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -578,7 +578,7 @@ test listrep-1.17 { test listrep-1.18 { Replacement of elements in middle more elements in unshared list results in a reallocated spanned list with space at front and back -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $one $two 10 11 12] validate $l list $l [spaceEqual $l] @@ -587,7 +587,7 @@ test listrep-1.18 { test listrep-1.19 { Replacement of elements at back with same number elements in unshared list is in-place - lreplace version -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $end-1 $end 10 11] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -596,7 +596,7 @@ test listrep-1.19 { test listrep-1.19.1 { Replacement of elements at back with same number elements in unshared list is in-place - lset version -} -body { +} -constraints testlistrep -body { set l [freeSpaceNone] lset l $end 10 validate $l @@ -606,7 +606,7 @@ test listrep-1.19.1 { test listrep-1.20 { Replacement of elements at back with fewer elements in unshared list is in-place with space only at the back -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $end-2 $end 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -615,7 +615,7 @@ test listrep-1.20 { test listrep-1.21 { Replacement of elements at back with more elements in unshared list allocates new representation with equal space at front and back -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceNone] $end-1 $end 10 11 12] validate $l list $l [spaceEqual $l] @@ -1667,7 +1667,7 @@ test listrep-3.22.1 { test listrep-3.23 { Replacement of elements at front with same number elements in unshared spanned list is in-place - lreplace version -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $zero $one 10 11] list $l [leadSpace $l] [tailSpace $l] } -result [list {10 11 2 3 4 5 6 7} 3 3] @@ -1675,7 +1675,7 @@ test listrep-3.23 { test listrep-3.23.1 { Replacement of elements at front with same number elements in unshared spanned list is in-place - lset version -} -body { +} -constraints testlistrep -body { set l [freeSpaceBoth] lset l $zero 10 list $l [leadSpace $l] [tailSpace $l] @@ -1684,7 +1684,7 @@ test listrep-3.23.1 { test listrep-3.24 { Replacement of elements at front with fewer elements in unshared spanned list expands leading space - lreplace version -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $zero $four 10] list $l [leadSpace $l] [tailSpace $l] } -result [list {10 5 6 7} 7 3] @@ -1692,7 +1692,7 @@ test listrep-3.24 { test listrep-3.25 { Replacement of elements at front with more elements in unshared spanned list with sufficient leading space shrinks leading space -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $zero $one 10 11 12] list $l [leadSpace $l] [tailSpace $l] } -result [list {10 11 12 2 3 4 5 6 7} 2 3] @@ -1719,7 +1719,7 @@ test listrep-3.27 { test listrep-3.28 { Replacement of elements at back with same number of elements in unshared spanned list is in-place - lreplace version -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $end-1 $end 10 11] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1728,7 +1728,7 @@ test listrep-3.28 { test listrep-3.28.1 { Replacement of elements at back with same number of elements in unshared spanned list is in-place - lset version -} -body { +} -constraints testlistrep -body { set l [freeSpaceBoth] lset l $end 10 validate $l @@ -1738,7 +1738,7 @@ test listrep-3.28.1 { test listrep-3.29 { Replacement of elements at back with fewer elements in unshared spanned list expands tail space -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $end-2 $end 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1747,7 +1747,7 @@ test listrep-3.29 { test listrep-3.30 { Replacement of elements at back with more elements in unshared spanned list with sufficient tail space shrinks tailspace -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $end-1 $end 10 11 12] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1756,7 +1756,7 @@ test listrep-3.30 { test listrep-3.31 { Replacement of elements at back with more elements in unshared spanned list with insufficient tail space but enough total free space moves up the span -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth 8 2 2] $end-1 $end 10 11 12 13 14] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1766,7 +1766,7 @@ test listrep-3.32 { Replacement of elements at back with more elements in unshared spanned list with insufficient total space reallocates with more room in the tail because of realloc() -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth 8 1 1] $end-1 $end 10 11 12 13 14] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1775,7 +1775,7 @@ test listrep-3.32 { test listrep-3.33 { Replacement of elements in the middle in an unshared spanned list with the same number of elements - lreplace version -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $two $four 10 11 12] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1784,7 +1784,7 @@ test listrep-3.33 { test listrep-3.33.1 { Replacement of elements in the middle in an unshared spanned list with the same number of elements - lset version -} -body { +} -constraints testlistrep -body { set l [freeSpaceBoth] lset l $two 10 validate $l @@ -1794,7 +1794,7 @@ test listrep-3.33.1 { test listrep-3.34 { Replacement of elements in an unshared spanned list with fewer elements in the front half moves the front (smaller) segment -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $two $four 10 11] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1803,7 +1803,7 @@ test listrep-3.34 { test listrep-3.35 { Replacement of elements in an unshared spanned list with fewer elements in the back half moves the tail (smaller) segment -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $end-2 $end-1 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1813,7 +1813,7 @@ test listrep-3.36 { Replacement of elements in an unshared spanned list with more elements when both front and back have room should move the smaller segment (front case) -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $one $two 8 9 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1823,7 +1823,7 @@ test listrep-3.37 { Replacement of elements in an unshared spanned list with more elements when both front and back have room should move the smaller segment (back case) -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $end-2 $end-1 8 9 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1832,7 +1832,7 @@ test listrep-3.37 { test listrep-3.38 { Replacement of elements in an unshared spanned list with more elements when only front has room -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth 8 3 1] $end-1 $end-1 8 9 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1841,7 +1841,7 @@ test listrep-3.38 { test listrep-3.39 { Replacement of elements in an unshared spanned list with more elements when only back has room -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth 8 1 3] $one $one 8 9 10] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1850,7 +1850,7 @@ test listrep-3.39 { test listrep-3.40 { Replacement of elements in an unshared spanned list with more elements when neither send has enough room by itself -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth] $one $one 8 9 10 11 12] validate $l list $l [leadSpace $l] [tailSpace $l] @@ -1860,7 +1860,7 @@ test listrep-3.41 { Replacement of elements in an unshared spanned list with more elements when there is not enough free space results in new allocation. The back end has more space because of realloc() -} -body { +} -constraints testlistrep -body { set l [lreplace [freeSpaceBoth 8 1 1] $one $one 8 9 10 11 12] validate $l list $l [leadSpace $l] [tailSpace $l] diff --git a/tests/load.test b/tests/load.test index 40901e5..005c451 100644 --- a/tests/load.test +++ b/tests/load.test @@ -31,7 +31,7 @@ testConstraint $dll [file readable $x] # Tests also require that this DLL has not already been loaded. set loaded "[file tail $x]Loaded" -set alreadyLoaded [info loaded] +set alreadyLoaded [info loaded {}] testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}] set alreadyTotalLoaded [info loaded] diff --git a/tests/lreplace.test b/tests/lreplace.test index 2952899..009170e 100644 --- a/tests/lreplace.test +++ b/tests/lreplace.test @@ -434,7 +434,7 @@ test ledit-4.4 {ledit edge case} { set l {1 2 3 4 5} list [ledit l 3 1] $l } {{1 2 3 4 5} {1 2 3 4 5}} -test lreplace-4.5 {lreplace edge case} { +test ledit-4.5 {ledit edge case} { lreplace {1 2 3 4 5} 3 0 _ } {1 2 3 _ 4 5} test ledit-4.6 {ledit end-x: bug a4cb3f06c4} { diff --git a/tests/lsearch.test b/tests/lsearch.test index 7c1402d..c913e60 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -552,7 +552,7 @@ test lsearch-23.1 {lsearch -stride option, errors} -body { } -returnCodes error -result {"-stride" option must be followed by stride length} test lsearch-23.2 {lsearch -stride option, errors} -body { lsearch -stride 0 {a b} a -} -returnCodes error -result {stride length must be at least 1} +} -returnCodes error -match glob -result {stride length must be between 1 and *} test lsearch-23.3 {lsearch -stride option, errors} -body { lsearch -stride 2 {a b c} a } -returnCodes error -result {list size must be a multiple of the stride length} @@ -688,6 +688,9 @@ test lsearch-28.8 {lsearch -sorted with -stride} -body { test lsearch-28.9 {lsearch -sorted with -stride} -body { lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9 } -result 9 +test lsearch-28.10 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 4294967296 -index 1 -subindices -inline {3 5 8 7 2 9} 9 +} -returnCodes 1 -match glob -result {stride length must be between 1 and *} # cleanup diff --git a/tests/lseq.test b/tests/lseq.test index e05b32d..b8ae2e9 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} { testConstraint arithSeriesDouble 1 testConstraint arithSeriesShimmer 1 -testConstraint arithSeriesShimmerOk 0 +testConstraint arithSeriesShimmerOk 1 ## Arg errors test lseq-1.1 {error cases} -body { @@ -223,6 +223,8 @@ test lseq-3.1 {experiement} { if {$ans eq {}} { set ans OK } + unset factor + unset l set ans } {OK} @@ -253,8 +255,9 @@ test lseq-3.7 {lmap lseq} { test lseq-3.8 {lrange lseq} { set r [lrange [lseq 1 100] 10 20] - lindex [tcl::unsupported::representation $r] 3 -} {arithseries} + set empty [lrange [lseq 1 100] 20 10] + list $r $empty [lindex [tcl::unsupported::representation $r] 3] +} {{11 12 13 14 15 16 17 18 19 20 21} {} arithseries} test lseq-3.9 {lassign lseq} arithSeriesShimmer { set r [lseq 15] @@ -376,13 +379,18 @@ test lseq-3.26 {lsort shimmer} arithSeriesShimmer { list ${rep-before} $lexical_sort ${rep-after} } {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries} -test lseq-3.27 {lreplace shimmer} arithSeriesShimmer { +test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body { set r [lseq 15 0] set rep-before [lindex [tcl::unsupported::representation $r] 3] set lexical_sort [lreplace $r 3 5 A B C] set rep-after [lindex [tcl::unsupported::representation $r] 3] list ${rep-before} $lexical_sort ${rep-after} -} {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries} +} -cleanup { + unset r + unset rep-before + unset lexical_sort + unset rep-after +} -result {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries} test lseq-3.28 {lreverse bug in ArithSeries} {} { set r [lseq -5 17 3] @@ -489,11 +497,54 @@ test lseq-4.4 {lseq corner case} -body { lappend res $s $e } eval $tcmd +} -cleanup { + unset res } -result {0 10 1 {max length of a Tcl list exceeded} 1 {max length of a Tcl list exceeded} 0 10 0 2147483638} +# Ticket 99e834bf33 - lseq, lindex end off by one + +test lseq-4.5 {lindex off by one} -body { + lappend res [eval {lindex [lseq 1 4] end}] + lappend res [eval {lindex [lseq 1 4] end-1}] +} -cleanup { + unset res +} -result {4 3} + +# Bad refcount on ResultObj +test lseq-4.6 {lindex flat} -body { + set l [lseq 2 10] + set cmd lindex + set i 4 + set c [lindex $l $i] + set d [$cmd $l $i] + set e [lindex [lseq 2 10] $i] + set f [$cmd [lseq 2 10] $i] + list $c $d $e $f +} -cleanup { + unset l + unset e +} -result [lrepeat 4 6] + +test lseq-4.7 {empty list} { + list [lseq 0] [join [lseq 0] {}] [join [lseq 1] {}] +} {{} {} 0} + +test lseq-4.8 {error case lrange} -body { + lrange [lseq 1 5] fred ginger +} -returnCodes 1 \ + -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?} + +test lseq-4.9 {error case lrange} -body { + set fred 7 + set ginger 8 + lrange [lseq 1 5] $fred $ginger +} -returnCodes 1 \ + -result {index 7 is out of bounds 0 to 4} + # cleanup ::tcltest::cleanupTests + return # Local Variables: diff --git a/tests/mathop.test b/tests/mathop.test index e38001d..3c25a2b 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -22,7 +22,7 @@ namespace eval ::testmathop2 { } # Helper to test math ops. -# Test different invokation variants and see that they do the same thing. +# Test different invocation variants and see that they do the same thing. # Byte compiled / non byte compiled version # Shared / unshared arguments # Original / imported @@ -114,22 +114,22 @@ namespace eval ::testmathop { test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.11 {compiled +: errors} -returnCodes error -body { + x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.12 {compiled +: errors} -returnCodes error -body { + nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.13 {compiled +: errors} -returnCodes error -body { + 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.14 {compiled +: errors} -returnCodes error -body { + 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.15 {compiled +: errors} -returnCodes error -body { + 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use invalid octal number "0o8" as operand of "+"} test mathop-1.16 {compiled +: errors} -returnCodes error -body { + 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use invalid octal number "0o8" as operand of "+"} test mathop-1.17 {compiled +: errors} -returnCodes error -body { + 0 [error expectedError] } -result expectedError @@ -152,22 +152,22 @@ namespace eval ::testmathop { test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.29 {interpreted +: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.30 {interpreted +: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.31 {interpreted +: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.32 {interpreted +: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.33 {interpreted +: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use invalid octal number "0o8" as operand of "+"} test mathop-1.34 {interpreted +: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use invalid octal number "0o8" as operand of "+"} test mathop-1.35 {interpreted +: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -189,22 +189,22 @@ namespace eval ::testmathop { test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.11 {compiled *: errors} -returnCodes error -body { * x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.12 {compiled *: errors} -returnCodes error -body { * nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.13 {compiled *: errors} -returnCodes error -body { * 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.14 {compiled *: errors} -returnCodes error -body { * 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.15 {compiled *: errors} -returnCodes error -body { * 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use invalid octal number "0o8" as operand of "*"} test mathop-2.16 {compiled *: errors} -returnCodes error -body { * 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use invalid octal number "0o8" as operand of "*"} test mathop-2.17 {compiled *: errors} -returnCodes error -body { * 0 [error expectedError] } -result expectedError @@ -227,22 +227,22 @@ namespace eval ::testmathop { test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.29 {interpreted *: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.30 {interpreted *: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.31 {interpreted *: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.32 {interpreted *: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.33 {interpreted *: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use invalid octal number "0o8" as operand of "*"} test mathop-2.34 {interpreted *: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use invalid octal number "0o8" as operand of "*"} test mathop-2.35 {interpreted *: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -261,7 +261,7 @@ namespace eval ::testmathop { test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0 test mathop-3.8 {compiled !: errors} -body { ! foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.9 {compiled !: errors} -body { ! 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -278,7 +278,7 @@ namespace eval ::testmathop { test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0 test mathop-3.18 {interpreted !: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.19 {interpreted !: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -287,10 +287,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.21 {compiled !: error} -returnCodes error -body { ! NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-3.22 {interpreted !: error} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-4.1 {compiled ~} {~ 0} -1 test mathop-4.2 {compiled ~} {~ 1} -2 @@ -301,7 +301,7 @@ namespace eval ::testmathop { test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001 test mathop-4.8 {compiled ~: errors} -body { ~ foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.9 {compiled ~: errors} -body { ~ 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -310,10 +310,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.11 {compiled ~: errors} -returnCodes error -body { ~ 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.12 {compiled ~: errors} -returnCodes error -body { ~ NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} set op ~ test mathop-4.13 {interpreted ~} {$op 0} -1 test mathop-4.14 {interpreted ~} {$op 1} -2 @@ -324,7 +324,7 @@ namespace eval ::testmathop { test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001 test mathop-4.20 {interpreted ~: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.21 {interpreted ~: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -333,10 +333,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.23 {interpreted ~: errors} -returnCodes error -body { $op 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.24 {interpreted ~: errors} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} test mathop-5.1 {compiled eq} {eq {} a} 0 test mathop-5.2 {compiled eq} {eq a a} 1 @@ -377,32 +377,32 @@ namespace eval ::testmathop { test mathop-6.4 {compiled &} { & 3 7 6 } 2 test mathop-6.5 {compiled &} -returnCodes error -body { & 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.6 {compiled &} -returnCodes error -body { & 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2 test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85 test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2 test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85 test mathop-6.11 {compiled &: errors} -returnCodes error -body { & x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.12 {compiled &: errors} -returnCodes error -body { & nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.13 {compiled &: errors} -returnCodes error -body { & 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.14 {compiled &: errors} -returnCodes error -body { & 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.15 {compiled &: errors} -returnCodes error -body { & 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use invalid octal number "0o8" as operand of "&"} test mathop-6.16 {compiled &: errors} -returnCodes error -body { & 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use invalid octal number "0o8" as operand of "&"} test mathop-6.17 {compiled &: errors} -returnCodes error -body { & 0 [error expectedError] } -result expectedError @@ -419,32 +419,32 @@ namespace eval ::testmathop { test mathop-6.22 {interpreted &} { $op 3 7 6 } 2 test mathop-6.23 {interpreted &} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.24 {interpreted &} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2 test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85 test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2 test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85 test mathop-6.29 {interpreted &: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.30 {interpreted &: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.31 {interpreted &: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.32 {interpreted &: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.33 {interpreted &: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use invalid octal number "0o8" as operand of "&"} test mathop-6.34 {interpreted &: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use invalid octal number "0o8" as operand of "&"} test mathop-6.35 {interpreted &: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -487,32 +487,32 @@ namespace eval ::testmathop { test mathop-7.4 {compiled |} { | 3 7 6 } 7 test mathop-7.5 {compiled |} -returnCodes error -body { | 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.6 {compiled |} -returnCodes error -body { | 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110 test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503 test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110 test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.11 {compiled |: errors} -returnCodes error -body { | x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.12 {compiled |: errors} -returnCodes error -body { | nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.13 {compiled |: errors} -returnCodes error -body { | 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.14 {compiled |: errors} -returnCodes error -body { | 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.15 {compiled |: errors} -returnCodes error -body { | 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use invalid octal number "0o8" as operand of "|"} test mathop-7.16 {compiled |: errors} -returnCodes error -body { | 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use invalid octal number "0o8" as operand of "|"} test mathop-7.17 {compiled |: errors} -returnCodes error -body { | 0 [error expectedError] } -result expectedError @@ -529,32 +529,32 @@ namespace eval ::testmathop { test mathop-7.22 {interpreted |} { $op 3 7 6 } 7 test mathop-7.23 {interpreted |} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.24 {interpreted |} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110 test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503 test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110 test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.29 {interpreted |: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.30 {interpreted |: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.31 {interpreted |: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.32 {interpreted |: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.33 {interpreted |: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use invalid octal number "0o8" as operand of "|"} test mathop-7.34 {interpreted |: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use invalid octal number "0o8" as operand of "|"} test mathop-7.35 {interpreted |: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -597,32 +597,32 @@ namespace eval ::testmathop { test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2 test mathop-8.5 {compiled ^} -returnCodes error -body { ^ 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.6 {compiled ^} -returnCodes error -body { ^ 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110 test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333 test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.11 {compiled ^: errors} -returnCodes error -body { ^ x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.12 {compiled ^: errors} -returnCodes error -body { ^ nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.13 {compiled ^: errors} -returnCodes error -body { ^ 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.14 {compiled ^: errors} -returnCodes error -body { ^ 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.15 {compiled ^: errors} -returnCodes error -body { ^ 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use invalid octal number "0o8" as operand of "^"} test mathop-8.16 {compiled ^: errors} -returnCodes error -body { ^ 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use invalid octal number "0o8" as operand of "^"} test mathop-8.17 {compiled ^: errors} -returnCodes error -body { ^ 0 [error expectedError] } -result expectedError @@ -639,32 +639,32 @@ namespace eval ::testmathop { test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2 test mathop-8.23 {interpreted ^} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.24 {interpreted ^} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110 test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333 test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.29 {interpreted ^: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.30 {interpreted ^: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.31 {interpreted ^: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.32 {interpreted ^: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.33 {interpreted ^: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use invalid octal number "0o8" as operand of "^"} test mathop-8.34 {interpreted ^: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use invalid octal number "0o8" as operand of "^"} test mathop-8.35 {interpreted ^: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -775,13 +775,13 @@ test mathop-20.6 { one arg, error } { # skipping - for now, knownbug... foreach op {+ * / & | ^ **} { lappend res [TestOp $op {*}$vals] - lappend exp "can't use non-numeric string as operand of \"$op\"\ + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric string}" } } foreach op {+ * / & | ^ **} { lappend res [TestOp $op NaN 1] - lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\ + lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric floating-point value}" } expr {$res eq $exp ? 0 : $res} @@ -850,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } { set res {} set exp {} lappend res [TestOp / x] - lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp - x] - lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ x] - lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ! x] - lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ 5.0] - lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-21.6 { unary ops, too many } { @@ -965,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } { set exp {} foreach op {& | ^} { lappend res [TestOp $op x 5] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 5 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } expr {$res eq $exp ? 0 : $res} } 0 @@ -1080,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } { set exp {} foreach op {% << >>} { lappend res [TestOp $op x 1] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 1 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } foreach op {% << >>} { lappend res [TestOp $op 5.0 1] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" lappend res [TestOp $op 1 5.0] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" } foreach op {in ni} { lappend res [TestOp $op 5 "a b \{ c"] @@ -1266,9 +1266,9 @@ test mathop-25.41 { exp operator errors } { lappend res [TestOp ** $huge 2.1] lappend exp "Inf" lappend res [TestOp ** 2 foo] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ** foo 2] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" expr {$res eq $exp ? 0 : $res} } 0 diff --git a/tests/msgcat.test b/tests/msgcat.test index 4549cee..6d2ba2c 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -1055,7 +1055,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} { variable locale if {![info exist locale]} { set locale [mclocale] } - test msgcat-14.1 {invokation loadcmd} -setup { + test msgcat-14.1 {invocation loadcmd} -setup { mcforgetpackage mclocale $locale mclocale "" @@ -1069,7 +1069,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} { lsort $resultvariable } -result {foo foo_bar} - test msgcat-14.2 {invokation failed in loadcmd} -setup { + test msgcat-14.2 {invocation failed in loadcmd} -setup { mcforgetpackage mclocale $locale mclocale "" @@ -1087,7 +1087,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} { list $err [dict get $errdict -code] } -result {fail 1} - test msgcat-14.3 {invokation changecmd} -setup { + test msgcat-14.3 {invocation changecmd} -setup { mcforgetpackage mclocale $locale mclocale "" @@ -1100,7 +1100,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} { set resultvariable } -result {foo_bar foo {}} - test msgcat-14.4 {invokation unknowncmd} -setup { + test msgcat-14.4 {invocation unknowncmd} -setup { mcforgetpackage mclocale $locale mclocale "" diff --git a/tests/obj.test b/tests/obj.test index 7563422..64a1d5b 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint testobj [llength [info commands testobj]] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] diff --git a/tests/ooNext2.test b/tests/ooNext2.test index 746f9a5..8d8cf45 100644 --- a/tests/ooNext2.test +++ b/tests/ooNext2.test @@ -126,7 +126,7 @@ test oo-nextto-1.3 {basic nextto functionality: constructors} -setup { variable result constructor {p q r} { lappend result ==C== p=$p,q=$q,r=$r - # Route arguments to superclasses, in non-trival pattern + # Route arguments to superclasses, in non-trivial pattern nextto B $q nextto A $p $r } diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test index 25840c6..33add42 100644 --- a/tests/pkgMkIndex.test +++ b/tests/pkgMkIndex.test @@ -490,7 +490,7 @@ removeFile [file join pkg pkg2_b.tcl] makeFile { # This package requires circ2, and circ2 requires circ3, which in turn -# requires circ1. In case of cirularities, pkg_mkIndex should give up when +# requires circ1. In case of circularities, pkg_mkIndex should give up when # it gets stuck. package require circ2 1.0 package provide circ1 1.0 @@ -654,7 +654,7 @@ test pkgMkIndex-12.1 {same name procs in different namespace} { removeFile [file join pkg samename.tcl] -# Proc names with embedded spaces are properly listed (ie, correct number of +# Proc names with embedded spaces are properly listed (i.e. correct number of # braces) in result makeFile { package provide spacename 1.0 diff --git a/tests/platform.test b/tests/platform.test index b5fd405..33aea3a 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -10,6 +10,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 +source [file join [file dirname [info script]] tcltests.tcl] namespace eval ::tcl::test::platform { namespace import ::tcltest::testConstraint @@ -22,7 +23,6 @@ namespace eval ::tcl::test::platform { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests testConstraint testCPUID [llength [info commands testcpuid]] testConstraint testlongsize [llength [info commands testlongsize]] diff --git a/tests/regexp.test b/tests/regexp.test index f0f05a0..16c775e 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} { } unset -nocomplain foo -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint exec [llength [info commands exec]] # Used for constraining memory leak tests diff --git a/tests/regexpComp.test b/tests/regexpComp.test index a556b7a..42f1b3b 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] # Procedure to evaluate a script within a proc, to test compilation # functionality diff --git a/tests/registry.test b/tests/registry.test index 4fc96bf..2f1fd8c 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -19,7 +19,7 @@ testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - set ::regver [package require registry 1.3.6] + set ::regver [package require registry 1.3.7] }]} { testConstraint reg 1 } @@ -34,7 +34,7 @@ testConstraint english [expr { test registry-1.0 {check if we are testing the right dll} {win reg} { set ::regver -} {1.3.6} +} {1.3.7} test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} diff --git a/tests/remote.tcl b/tests/remote.tcl index 6bc4b17..eee551a 100644 --- a/tests/remote.tcl +++ b/tests/remote.tcl @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# Initialize message delimitor +# Initialize message delimiter # Initialize command array catch {unset command} diff --git a/tests/resolver.test b/tests/resolver.test index 51df07c..ea84956 100644 --- a/tests/resolver.test +++ b/tests/resolver.test @@ -203,7 +203,7 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup { # resolver-agnostic). # # In order to make the test cases for the per-interpreter cmd literal pool -# reproducable and to minimize interactions between test cases, we use a child +# reproducible and to minimize interactions between test cases, we use a child # interpreter per test-case. # # diff --git a/tests/safe-stock.test b/tests/safe-stock.test index bfea85c..24e90a0 100644 --- a/tests/safe-stock.test +++ b/tests/safe-stock.test @@ -97,12 +97,19 @@ proc mapAndSortList {map listIn} { lsort $listOut } -# Force actual loading of the safe package because we use un-exported (and -# thus un-autoindexed) APIs in this test result arguments: +# Force actual loading of the safe package because we use unexported (and +# thus unautoindexed) APIs in this test result arguments: catch {safe::interpConfigure} +testConstraint AutoSyncDefined 1 + # high level general test -test safe-stock-7.1 {tests that everything works at high level, uses pkg opt} -setup { +test safe-stock-7.1 {tests that everything works at high level with conventional AutoPathSync, use pkg opt} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set i [safe::interpCreate] } -body { # no error shall occur: @@ -114,8 +121,18 @@ test safe-stock-7.1 {tests that everything works at high level, uses pkg opt} -s set v } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result 0.4.* -test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath, uses pkg opt} -setup { +test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync, use pkg opt} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } else { + set SyncVal_TMP 1 + } } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) @@ -130,9 +147,19 @@ test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath, uses pk [catch {interp eval $i {package require opt}} msg] $msg -- \ $mappA -- [safe::interpDelete $i] } -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result "{\$p(:0:)} {\$p(:*:)} -- 1 {$pkgOptErrMsg} --\ {TCLLIB */dummy/unixlike/test/path} -- {}" -test safe-stock-7.4 {tests specific path and positive search, uses pkg opt} -setup { +test safe-stock-7.4 {tests specific path and positive search with conventional AutoPathSync, use pkg opt} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } else { + set SyncVal_TMP 1 + } } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) @@ -148,8 +175,35 @@ test safe-stock-7.4 {tests specific path and positive search, uses pkg opt} -set # Note that the glob match elides directories (those from the module path) # other than the first and last in the access path. } -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 0.4.* --\ {TCLLIB * TCLLIB/OPTDIR} -- {}} +test safe-stock-7.5 {tests positive and negative module loading with conventional AutoPathSync} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } + set i [safe::interpCreate] + interp eval $i { + package forget platform::shell + package forget platform + catch {namespace delete ::platform} + } +} -body { + # Should raise an error (module ancestor directory issue) + set code1 [catch {interp eval $i {package require shell}} msg1] + # Should not raise an error + set code2 [catch {interp eval $i {package require platform::shell}} msg2] + return [list $code1 $msg1 $code2] +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {1 {can't find package shell} 0} # The following test checks whether the definition of tcl_endOfWord can be # obtained from auto_loading. It was previously test "safe-5.1". @@ -161,7 +215,12 @@ test safe-stock-9.8 {test auto-loading in safe interpreters, was safe-5.1} -setu } -cleanup { safe::interpDelete a } -result -1 -test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, uses pkg opt and tcl::idna} -setup { +test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement with conventional AutoPathSync, uses pkg opt and tcl::idna} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $tcl_library $pkgOptDir] \ @@ -196,11 +255,19 @@ test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packa $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 1.* 0 0.4.* --\ {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} --\ {TCLLIB TCLLIB/JARDIR TCLLIB/OPTDIR*} --\ 0 0 0 example.com} -test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, uses pkg opt and tcl::idna} -setup { +test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed with conventional AutoPathSync, uses pkg opt and tcl::idna} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $tcl_library $pkgOptDir] \ @@ -231,9 +298,138 @@ test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packa $mappA -- $mappB } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ 1 {* not found in access path} -- 1 1 --\ {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} -- {TCLLIB*}} + +test safe-stock-18.1 {cf. safe-stock-7.1opt - tests that everything works at high level without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + # Without AutoPathSync, we need a more complete auto_path, + # because the child will use the same value. + set lib1 [info library] + set lib2 [file dirname $lib1] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] + set ::auto_path $::auto_TMP +} -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a child works like in the parent) + set v [interp eval $i {package require opt}] + # no error shall occur: + interp eval $i {::tcl::Lempty {a list}} + set v +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result 0.4.* +test safe-stock-18.2 {cf. safe-stock-7.2opt - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + set auto1 [interp eval $i {set ::auto_path}] + # This will differ from the value -autoPath {} + interp eval $i {set ::auto_path [list {$p(:0:)}]} + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if parent has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # an error shall occur (opt is not anymore in the secure 0-level + # provided deep path) + list $auto1 $token1 $token2 \ + [catch {interp eval $i {package require opt}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} 1 {$pkgOptErrMsg}\ + {-accessPath {[list $tcl_library */dummy/unixlike/test/path]}\ + -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}" +test safe-stock-18.4 {cf. safe-stock-7.4opt - tests specific path and positive search and auto_path without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + + # should not have been set by Safe Base: + set auto1 [interp eval $i {set ::auto_path}] + + # This will differ from the value -autoPath {} + interp eval $i {set ::auto_path [list {$p(:0:)}]} + + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + + # should add as p* (not p1 if parent has a module path) + set token2 [safe::interpAddToAccessPath $i [file join [info library] $pkgOptDir]] + + # should not have been changed by Safe Base: + set auto2 [interp eval $i {set ::auto_path}] + + # This time, unlike test safe-stock-18.2opt and the try above, opt should be found: + list $auto1 $auto2 $token1 $token2 \ + [catch {interp eval $i {package require opt}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} 0 0.4.*\ + {-accessPath {[list $tcl_library *$tcl_library/$pkgOptDir]}\ + -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}" +test safe-stock-18.5 {cf. safe-stock-7.5 - tests positive and negative module loading without conventional AutoPathSync} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate] + interp eval $i { + package forget platform::shell + package forget platform + catch {namespace delete ::platform} + } +} -body { + # Should raise an error (tests module ancestor directory rule) + set code1 [catch {interp eval $i {package require shell}} msg1] + # Should not raise an error + set code2 [catch {interp eval $i {package require platform::shell}} msg2] + return [list $code1 $msg1 $code2] +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {1 {can't find package shell} 0} set ::auto_path $SaveAutoPath unset pkgOptErrMsg pkgOptDir pkgJarDir SaveAutoPath TestsDir PathMapp diff --git a/tests/safe-stock86.test b/tests/safe-stock86.test deleted file mode 100644 index e69de29..0000000 --- a/tests/safe-stock86.test +++ /dev/null diff --git a/tests/safe-zipfs.test b/tests/safe-zipfs.test index a6088c4..41c4b78 100644 --- a/tests/safe-zipfs.test +++ b/tests/safe-zipfs.test @@ -55,6 +55,8 @@ apply [list {} { # thus un-autoindexed) APIs in this test result arguments: catch {safe::interpConfigure} + testConstraint AutoSyncDefined 1 + # Tests 5.* test the example files before using them to test safe interpreters. test safe-zipfs-5.1 {example tclIndex commands, test in parent interpreter; zipfs} -setup { @@ -104,8 +106,7 @@ apply [list {} { } -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2} test safe-zipfs-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories; zipfs} -setup { set tmpAutoPath $::auto_path - lappend ::auto_path [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2] + lappend ::auto_path [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2] } -body { # Try to load the packages and run a command from each one. set code3 [catch {package require SafeTestPackage1} msg3] @@ -168,7 +169,12 @@ apply [list {} { # high level general test # Use zipped example packages not http1.0 etc - test safe-zipfs-7.1 {tests that everything works at high level; zipfs} -setup { + test safe-zipfs-7.1 {tests that everything works at high level with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set tmpAutoPath $::auto_path lappend ::auto_path [file join $ZipMountPoint auto0] set i [safe::interpCreate] @@ -183,8 +189,18 @@ apply [list {} { set v } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result 1.2.3 - test safe-zipfs-7.2 {tests specific path and interpFind/AddToAccessPath; zipfs} -setup { + test safe-zipfs-7.2 {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } else { + set SyncVal_TMP 1 + } } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) @@ -197,14 +213,20 @@ apply [list {} { set mappA [mapList $PathMapp [dict get $confA -accessPath]] # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level # provided deep path) - list $token1 $token2 $token3 -- \ - [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ - $mappA -- [safe::interpDelete $i] + list $token1 $token2 $token3 -- [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- $mappA -- [safe::interpDelete $i] } -cleanup { - } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\ - 1 {can't find package SafeTestPackage1} --\ - {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}} - test safe-zipfs-7.4 {tests specific path and positive search; zipfs} -setup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} -- 1 {can't find package SafeTestPackage1} -- {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}} + test safe-zipfs-7.4 {tests specific path and positive search with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } else { + set SyncVal_TMP 1 + } } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) @@ -214,20 +236,23 @@ apply [list {} { set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] # this time, unlike test safe-zipfs-7.2, SafeTestPackage1 should be found - list $token1 $token2 -- \ - [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ - $mappA -- [safe::interpDelete $i] + list $token1 $token2 -- [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- $mappA -- [safe::interpDelete $i] # Note that the glob match elides directories (those from the module path) # other than the first and last in the access path. } -cleanup { - } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\ - {TCLLIB * ZIPDIR/auto0/auto1} -- {}} + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 -- {TCLLIB * ZIPDIR/auto0/auto1} -- {}} - test safe-zipfs-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset); zipfs} -setup { + test safe-zipfs-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset) with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { - set i [safe::interpCreate -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]]] + set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] @@ -243,9 +268,7 @@ apply [list {} { set code2 [catch {interp eval $i {report2}} msg2] # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. - safe::interpConfigure $i -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto2] \ - [file join $ZipMountPoint auto0 auto1]] + safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto2] [file join $ZipMountPoint auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] @@ -259,14 +282,18 @@ apply [list {} { list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i - } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\ - {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\ - {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}} - test safe-zipfs-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset); zipfs} -setup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}} + test safe-zipfs-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset) with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { - set i [safe::interpCreate -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]]] + set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] @@ -280,9 +307,7 @@ apply [list {} { # will pass only if the Safe Base has called auto_reset. # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. - safe::interpConfigure $i -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto2] \ - [file join $ZipMountPoint auto0 auto1]] + safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto2] [file join $ZipMountPoint auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] @@ -296,17 +321,19 @@ apply [list {} { list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i - } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ - 0 ok1 0 ok2 --\ - {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\ - {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}} - test safe-zipfs-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement; zipfs} -setup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}} + test safe-zipfs-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { - # For complete correspondence to safe-stock87-9.11, include auto0 in access path. - set i [safe::interpCreate -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0] \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]]] + # For complete correspondence to safe-stock-9.11, include auto0 in access path. + set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0] [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] @@ -320,10 +347,7 @@ apply [list {} { # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}. # This would have no effect because the records in Pkg of these directories # were from access as children of {$p(:1:)}. - safe::interpConfigure $i -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0] \ - [file join $ZipMountPoint auto0 auto2] \ - [file join $ZipMountPoint auto0 auto1]] + safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0] [file join $ZipMountPoint auto0 auto2] [file join $ZipMountPoint auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] @@ -336,19 +360,21 @@ apply [list {} { set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] - list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ - $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i - } -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\ - {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\ - {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\ - 0 OK1 0 OK2} - test safe-zipfs-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0; zipfs} -setup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 -- {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} -- 0 OK1 0 OK2} + test safe-zipfs-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0 with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { - set i [safe::interpCreate -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]]] + set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] @@ -359,9 +385,7 @@ apply [list {} { catch {interp eval $i {package require NOEXIST}} # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. - safe::interpConfigure $i -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto2] \ - [file join $ZipMountPoint auto0 auto1]] + safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto2] [file join $ZipMountPoint auto0 auto1]] # Inspect. set confB [safe::interpConfigure $i] set mappB [mapList $PathMapp [dict get $confB -accessPath]] @@ -374,20 +398,21 @@ apply [list {} { set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] - list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ - $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i - } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ - 0 1.2.3 0 2.3.4 --\ - {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\ - {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\ - 0 OK1 0 OK2} - test safe-zipfs-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed; zipfs} -setup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 1.2.3 0 2.3.4 -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} -- 0 OK1 0 OK2} + test safe-zipfs-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { - set i [safe::interpCreate -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]]] + set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]] # Inspect. set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] @@ -410,14 +435,19 @@ apply [list {} { set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3] set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6] - list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \ - $mappA -- $mappB + list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i - } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ - 1 {* not found in access path} -- 1 1 --\ - {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB*}} - test safe-zipfs-9.20 {check module loading; zipfs} -setup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} -- 1 {* not found in access path} -- 1 1 -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB*}} + test safe-zipfs-9.20 {check module loading, with conventional AutoPathSync; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -442,18 +472,17 @@ apply [list {} { set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] - list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2 + list [lsort [list $path0 $path1 $path2]] -- $modsA -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $ZipMountPoint auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i - } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ - 0 0.5 0 1.0 0 2.0 --\ - {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ - ZIPDIR/auto0/modules/mod2} -- res0 res1 res2} + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2} # - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in # tokenized form to the child's access path, and then adds all the # descendants, discovered recursively by using glob. @@ -463,7 +492,12 @@ apply [list {} { # directories in the access path. Both those things must be sorted before # comparing with expected results. The test is therefore not totally strict, # but will notice missing or surplus directories. - test safe-zipfs-9.21 {interpConfigure change the access path; check module loading; stale data case 1; zipfs} -setup { + test safe-zipfs-9.21 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 1; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -482,9 +516,7 @@ apply [list {} { # Add to access path. # This injects more tokens, pushing modules to higher token numbers. - safe::interpConfigure $i -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]] + safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] @@ -506,26 +538,24 @@ apply [list {} { set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] - list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ - [lsort [list $path3 $path4 $path5]] -- $modsB -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ - $out0 $out1 $out2 + list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $ZipMountPoint auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i - } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ - {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ - 0 0.5 0 1.0 0 2.0 --\ - {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ - ZIPDIR/auto0/modules/mod2} --\ - {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\ - ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\ - res0 res1 res2} + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2} # See comments on lsort after test safe-zipfs-9.20. - test safe-zipfs-9.22 {interpConfigure change the access path; check module loading; stale data case 0; zipfs} -setup { + test safe-zipfs-9.22 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 0; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -544,9 +574,7 @@ apply [list {} { # Add to access path. # This injects more tokens, pushing modules to higher token numbers. - safe::interpConfigure $i -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]] + safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] @@ -563,26 +591,24 @@ apply [list {} { set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] - list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ - [lsort [list $path3 $path4 $path5]] -- $modsB -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ - $out0 $out1 $out2 + list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $ZipMountPoint auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i - } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ - {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ - 0 0.5 0 1.0 0 2.0 --\ - {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ - ZIPDIR/auto0/modules/mod2} --\ - {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\ - ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\ - res0 res1 res2} + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2} # See comments on lsort after test safe-zipfs-9.20. - test safe-zipfs-9.23 {interpConfigure change the access path; check module loading; stale data case 3; zipfs} -setup { + test safe-zipfs-9.23 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 3; zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -606,9 +632,7 @@ apply [list {} { # Add to access path. # This injects more tokens, pushing modules to higher token numbers. - safe::interpConfigure $i -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]] + safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] @@ -630,26 +654,24 @@ apply [list {} { set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] - list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ - [lsort [list $path3 $path4 $path5]] -- $modsB -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ - $out0 $out1 $out2 + list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $ZipMountPoint auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i - } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ - {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ - 0 0.5 0 1.0 0 2.0 --\ - {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ - ZIPDIR/auto0/modules/mod2} --\ - {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\ - ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\ - res0 res1 res2} + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2} # See comments on lsort after test safe-zipfs-9.20. - test safe-zipfs-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case); zipfs} -setup { + test safe-zipfs-9.24 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 2 (worst case); zipfs} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -673,9 +695,7 @@ apply [list {} { # Add to access path. # This injects more tokens, pushing modules to higher token numbers. - safe::interpConfigure $i -accessPath [list $tcl_library \ - [file join $ZipMountPoint auto0 auto1] \ - [file join $ZipMountPoint auto0 auto2]] + safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]] # Inspect. set confB [safe::interpConfigure $i] set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] @@ -692,26 +712,116 @@ apply [list {} { set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] - list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ - [lsort [list $path3 $path4 $path5]] -- $modsB -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ - $out0 $out1 $out2 + list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $ZipMountPoint auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i - } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ - {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ - 0 0.5 0 1.0 0 2.0 --\ - {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\ - ZIPDIR/auto0/modules/mod2} --\ - {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\ - ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\ - res0 res1 res2} + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2} # See comments on lsort after test safe-zipfs-9.20. - + + test safe-zipfs-18.1 {cf. safe-zipfs-7.1 - tests that everything works at high level without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + # Without AutoPathSync, we need a more complete auto_path, + # because the child will use the same value. + set lib1 [info library] + set lib2 [file join $ZipMountPoint auto0] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] + set ::auto_path $::auto_TMP + } -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a child works like in the parent) + set v [interp eval $i {package require SafeTestPackage1}] + # no error shall occur: + interp eval $i HeresPackage1 + set v + } -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result 1.2.3 + test safe-zipfs-18.2 {cf. safe-zipfs-7.2 - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + } -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + set auto1 [interp eval $i {set ::auto_path}] + interp eval $i {set ::auto_path [list {$p(:0:)}]} + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if parent has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # should add as p* (not p2 if parent has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]] + # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level + # provided deep path) + list $auto1 $token1 $token2 $token3 [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg [safe::interpConfigure $i] [safe::interpDelete $i] + } -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result "{} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 1 {can't find package SafeTestPackage1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path $ZipMountPoint/auto0]} -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}" + test safe-zipfs-18.4 {cf. safe-zipfs-7.4 - tests specific path and positive search and auto_path without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + } -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + + # should not have been set by Safe Base: + set auto1 [interp eval $i {set ::auto_path}] + + # This will differ from the value -autoPath {} + interp eval $i {set ::auto_path [list {$p(:0:)}]} + + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + + # should add as p* (not p1 if parent has a module path) + set token2 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]] + + # should add as p* (not p2 if parent has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0 auto1]] + + # should not have been changed by Safe Base: + set auto2 [interp eval $i {set ::auto_path}] + + # This will differ from the value -autoPath {} + set auto3 [interp eval $i [list set ::auto_path [list {$p(:0:)} $token2]]] + + # This time, unlike test safe-zipfs-18.2 and the try above, SafeTestPackage1 should be found: + list $auto1 $auto2 $token1 $token2 $token3 [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg [safe::interpConfigure $i] [safe::interpDelete $i] + } -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } + } -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 0 1.2.3 {-accessPath {[list $tcl_library *$ZipMountPoint/auto0 $ZipMountPoint/auto0/auto1]} -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}" + # cleanup set ::auto_path $SaveAutoPath zipfs unmount ${ZipMountPoint} diff --git a/tests/safe.test b/tests/safe.test index fc7c814..0a888f4 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -8,7 +8,7 @@ # - Tests that used http are replaced here with tests that use example packages # provided in subdirectory auto0 of the tests directory, which are independent # of any changes made to the packages provided with Tcl itself. -# - These are tests 7.1 7.2 7.4 9.11 9.13 +# - These are tests 7.1 7.2 7.4 9.11 9.13 17.1 17.2 17.4 # - Tests 5.* test the example packages themselves before they # are used to test Safe Base interpreters. # - Alternative tests using stock packages of Tcl 8.7 are in file @@ -36,6 +36,11 @@ set ::auto_path [info library] set TestsDir [file normalize [file dirname [info script]]] set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR] +proc getAutoPath {child} { + set ap1 [lrange [lindex [safe::interpConfigure $child -autoPath] 1] 0 end] + set ap2 [::safe::DetokPath $child [interp eval $child set ::auto_path]] + list $ap1 -- $ap2 +} proc mapList {map listIn} { set listOut {} foreach element $listIn { @@ -51,21 +56,36 @@ proc mapAndSortList {map listIn} { lsort $listOut } -# Force actual loading of the safe package because we use un-exported (and -# thus un-autoindexed) APIs in this test result arguments: +# Force actual loading of the safe package because we use unexported (and +# thus unautoindexed) APIs in this test result arguments: catch {safe::interpConfigure} # testing that nested and statics do what is advertised (we use a static # package - tcl::test - but it might be absent if we're in standard tclsh) testConstraint tcl::test [expr {![catch {package require tcl::test}]}] +testConstraint AutoSyncDefined 1 +### 1. Basic help/error messages. + test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body { safe::interpConfigure } -result {no value given for parameter "child" (use -help for full usage) : child name () name of the child} -test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body { +test safe-1.2 {safe::interpCreate syntax, Sync Mode on} -returnCodes error -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } else { + set SyncVal_TMP 1 + } +} -body { safe::interpCreate -help +} -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -result {Usage information: Var/FlagName Type Value Help ------------ ---- ----- ---- @@ -77,11 +97,39 @@ test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body { -nestedLoadOk boolflag (false) allow nested loading -nested boolean (false) nested loading -deleteHook script () delete hook} +test safe-1.2.1 {safe::interpCreate syntax, Sync Mode off} -returnCodes error -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + safe::interpCreate -help +} -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {Usage information: + Var/FlagName Type Value Help + ------------ ---- ----- ---- + (-help gives this help) + ?child? name () name of the child (optional) + -accessPath list () access path for the child + -noStatics boolflag (false) prevent loading of statically linked pkgs + -statics boolean (true) loading of statically linked pkgs + -nestedLoadOk boolflag (false) allow nested loading + -nested boolean (false) nested loading + -deleteHook script () delete hook + -autoPath list () ::auto_path for the child} test safe-1.3 {safe::interpInit syntax} -returnCodes error -body { safe::interpInit -noStatics } -result {bad value "-noStatics" for parameter child name () name of the child} +### 2. Aliases in a new "interp create" interpreter. + test safe-2.1 {creating interpreters, should have no aliases} emptyTest { # Disabled this test. It tests nothing sensible. [Bug 999612] # interp aliases @@ -105,6 +153,9 @@ test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -s interp delete a } -result {clock} +### 3. Simple use of interpCreate, interpInit. +### Aliases in a new "interpCreate/interpInit" interpreter. + test safe-3.1 {calling safe::interpInit is safe} -setup { catch {safe::interpDelete a} interp create a -safe @@ -139,6 +190,8 @@ test safe-3.4 {calling safe::interpCreate on trusted interp} -setup { safe::interpDelete a } -result {} +### 4. Testing safe::interpDelete, double interpCreate. + test safe-4.1 {safe::interpDelete} -setup { catch {safe::interpDelete a} } -body { @@ -171,9 +224,9 @@ test safe-4.6 {safe::interpDelete, indirectly} -setup { a eval exit } -result "" -# The old test "safe-5.1" has been moved to "safe-stock-9.8". -# A replacement test using example files is "safe-9.8". -# Tests 5.* test the example files before using them to test safe interpreters. +### 5. Test the example files before using them to test safe interpreters. +### The old test "safe-5.1" has been moved to "safe-stock-9.8". +### A replacement test using example files is "safe-9.8". unset -nocomplain path @@ -286,7 +339,8 @@ test safe-5.6 {example modules packages, test in parent interpreter, append to p catch {namespace delete ::mod1} } -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} -# test safe interps 'information leak' +### 6. Test safe interps 'information leak'. + proc SafeEval {script} { # Helper procedure that ensures the safe interp is cleaned up even if # there is a failure in the script. @@ -316,9 +370,16 @@ rename SafeEval {} # More test should be added to check that hostname, nameofexecutable, aren't # leaking infos, but they still do... -# high level general test -# Use example packages not http1.0 etc -test safe-7.1 {tests that everything works at high level} -setup { +### 7. Test the use of ::auto_path for loading commands (via tclIndex files) +### and non-module packages (via pkgIndex.tcl files). +### Corresponding tests with Sync Mode off are 17.* + +test safe-7.1 {positive non-module package require, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0] set i [safe::interpCreate] @@ -333,8 +394,18 @@ test safe-7.1 {tests that everything works at high level} -setup { set v } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result 1.2.3 -test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup { +test safe-7.2 {negative non-module package require with specific path and interpAddToAccessPath, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } else { + set SyncVal_TMP 1 + } } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) @@ -345,12 +416,14 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup { set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] set confA [safe::interpConfigure $i] set mappA [mapList $PathMapp [dict get $confA -accessPath]] - # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level - # provided deep path) + # an error shall occur (SafeTestPackage1 is not in auto0 but a subdirectory) list $token1 $token2 $token3 -- \ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ $mappA -- [safe::interpDelete $i] } -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\ 1 {can't find package SafeTestPackage1} --\ {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}} @@ -385,7 +458,14 @@ test safe-7.3.1 {check that safe subinterpreters work with namespace names} -set [safe::interpDelete $i] \ [interp exists $j] [info vars ::safe::S*] } -match glob -result {{} {} ok ok {} 0 {}} -test safe-7.4 {tests specific path and positive search} -setup { +test safe-7.4 {positive non-module package require with specific path and interpAddToAccessPath, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } else { + set SyncVal_TMP 1 + } } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) @@ -401,10 +481,39 @@ test safe-7.4 {tests specific path and positive search} -setup { # Note that the glob match elides directories (those from the module path) # other than the first and last in the access path. } -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\ {TCLLIB * TESTSDIR/auto0/auto1} -- {}} +test safe-7.5 {positive and negative module package require, including ancestor directory issue, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } + tcl::tm::path add [file join $TestsDir auto0 modules] + set i [safe::interpCreate] + tcl::tm::path remove [file join $TestsDir auto0 modules] + interp eval $i { + package forget mod1::test1 + catch {namespace delete ::mod1} + } +} -body { + # Should raise an error (module ancestor directory issue) + set code1 [catch {interp eval $i {package require test1}} msg1] + # Should not raise an error + set code2 [catch {interp eval $i {package require mod1::test1}} msg2] + return [list $code1 $msg1 $code2] +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {1 {can't find package test1} 0} + +### 8. Test source control on file name. -# test source control on file name test safe-8.1 {safe source control on file} -setup { set i "a" catch {safe::interpDelete $i} @@ -549,6 +658,9 @@ test safe-8.10 {safe source and return} -setup { unset i } -result ok +### 9. Assorted options, including changes to option values. +### If Sync Mode is on, a corresponding test with Sync Mode off is 19.* + test safe-9.1 {safe interps' deleteHook} -setup { set i "a" catch {safe::interpDelete $i} @@ -651,7 +763,12 @@ test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body { {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\ {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\ {-accessPath * -statics 0 -nested 0 -deleteHook toto}} -test safe-9.8 {test autoloading commands indexed in tclIndex files} -setup { +test safe-9.8 {autoloading commands indexed in tclIndex files, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ @@ -669,9 +786,17 @@ test safe-9.8 {test autoloading commands indexed in tclIndex files} -setup { list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}} -test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup { +test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset), Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ @@ -707,10 +832,18 @@ test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffec list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}} -test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup { +test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset), Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ @@ -744,11 +877,19 @@ test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffe list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ 0 ok1 0 ok2 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}} -test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup { +test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { # For complete correspondence to safe-9.10opt, include auto0 in access path. set i [safe::interpCreate -accessPath [list $tcl_library \ @@ -788,11 +929,19 @@ test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages un $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ 0 OK1 0 OK2} -test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup { +test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, safe-9.11 without path auto0, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ @@ -827,12 +976,20 @@ test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages un $code5 $msg5 $code6 $msg6 } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ 0 1.2.3 0 2.3.4 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ 0 OK1 0 OK2} -test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup { +test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ @@ -863,10 +1020,18 @@ test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fa $mappA -- $mappB } -cleanup { safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ 1 {* not found in access path} -- 1 1 --\ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}} -test safe-9.20 {check module loading} -setup { +test safe-9.20 {check module loading, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -899,6 +1064,9 @@ test safe-9.20 {check module loading} -setup { tcl::tm::path add $path } safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ 0 0.5 0 1.0 0 2.0 --\ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ @@ -912,7 +1080,12 @@ test safe-9.20 {check module loading} -setup { # directories in the access path. Both those things must be sorted before # comparing with expected results. The test is therefore not totally strict, # but will notice missing or surplus directories. -test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup { +test safe-9.21 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 1} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -965,6 +1138,9 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st tcl::tm::path add $path } safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ @@ -974,7 +1150,12 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. -test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup { +test safe-9.22 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 0} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -1022,6 +1203,9 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st tcl::tm::path add $path } safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ @@ -1031,7 +1215,12 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. -test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup { +test safe-9.23 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 3} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -1089,6 +1278,9 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st tcl::tm::path add $path } safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ @@ -1098,7 +1290,12 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ res0 res1 res2} # See comments on lsort after test safe-9.20. -test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup { +test safe-9.24 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 2 (worst case)} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -1151,6 +1348,9 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st tcl::tm::path add $path } safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ @@ -1161,6 +1361,8 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st res0 res1 res2} # See comments on lsort after test safe-9.20. +### 10. Test options -statics -nostatics -nested -nestedloadok + catch {teststaticlibrary Safepfx1 0 0} test safe-10.1 {testing statics loading} -constraints tcl::test -setup { set i [safe::interpCreate] @@ -1214,6 +1416,8 @@ test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints t invoked from within "interp eval $i {interp create x; load {} Safepfx1 x}"} +### 11. Safe encoding. + test safe-11.1 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { @@ -1269,7 +1473,7 @@ test safe-11.7 {testing safe encoding} -setup { interp eval $i encoding convertfrom } -returnCodes error -cleanup { safe::interpDelete $i -} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data"} +} -result {wrong # args: should be "encoding convertfrom ?-profile profile? ?-failindex var? encoding data" or "encoding convertfrom data"} test safe-11.7.1 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { @@ -1278,7 +1482,7 @@ test safe-11.7.1 {testing safe encoding} -setup { } -match glob -cleanup { unset -nocomplain m o safe::interpDelete $i -} -result {wrong # args: should be "encoding convertfrom ?-nocomplain? ?-failindex var? ?encoding? data" +} -result {wrong # args: should be "encoding convertfrom ?-profile profile? ?-failindex var? encoding data" or "encoding convertfrom data" while executing "encoding convertfrom" invoked from within @@ -1291,7 +1495,7 @@ test safe-11.8 {testing safe encoding} -setup { interp eval $i encoding convertto } -returnCodes error -cleanup { safe::interpDelete $i -} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data"} +} -result {wrong # args: should be "encoding convertto ?-profile profile? ?-failindex var? encoding data" or "encoding convertto data"} test safe-11.8.1 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { @@ -1300,7 +1504,7 @@ test safe-11.8.1 {testing safe encoding} -setup { } -match glob -cleanup { unset -nocomplain m o safe::interpDelete $i -} -result {wrong # args: should be "encoding convertto ?-nocomplain? ?-failindex var? ?encoding? data" +} -result {wrong # args: should be "encoding convertto ?-profile profile? ?-failindex var? encoding data" or "encoding convertto data" while executing "encoding convertto" invoked from within @@ -1308,6 +1512,9 @@ test safe-11.8.1 {testing safe encoding} -setup { invoked from within "interp eval $i encoding convertto"} +### 12. Safe glob. +### More tests of glob in sections 13, 16. + test safe-12.1 {glob is restricted [Bug 2906841]} -setup { set i [safe::interpCreate] } -body { @@ -1358,6 +1565,9 @@ test safe-12.7 {glob is restricted} -setup { safe::interpDelete $i } -result {permission denied} +### 13. More tests for Safe base glob, with patches @ Bug 2964715 +### More tests of glob in sections 12, 16. + proc buildEnvironment {filename} { upvar 1 testdir testdir testdir2 testdir2 testfile testfile set testdir [makeDirectory deletethisdir] @@ -1373,7 +1583,7 @@ proc buildEnvironment2 {filename} { set testdir3 [makeDirectory deleteme $testdir] set testfile2 [makeFile {} $filename $testdir3] } -#### New tests for Safe base glob, with patches @ Bug 2964715 + test safe-13.1 {glob is restricted [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { @@ -1510,7 +1720,8 @@ test safe-13.10 {as 13.8 but test silent failure when result is outside access_p rename buildEnvironment {} rename buildEnvironment2 {} -#### Test for the module path +### 14. Sanity checks on paths - module path, access path, auto_path. + test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup { set i [safe::interpCreate] } -body { @@ -1522,6 +1733,122 @@ test safe-14.1 {Check that module path is the same as in the parent interpreter } -cleanup { safe::interpDelete $i } -result [::tcl::tm::path list] +test safe-14.2 {Check that first element of child auto_path (and access path) is Tcl Library, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } + + set lib1 [info library] + set lib2 [file dirname $lib1] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] +} -body { + set autoList {} + set token [lindex [$i eval set ::auto_path] 0] + set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token] + set accessList [lindex [safe::interpConfigure $i -accessPath] 1] + return [list [lindex $accessList 0] $auto0] +} -cleanup { + set ::auto_path $::auto_TMP + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [info library] [info library]] +test safe-14.2.1 {Check that first element of child auto_path (and access path) is Tcl Library, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + + set lib1 [info library] + set lib2 [file dirname $lib1] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] +} -body { + set autoList {} + set token [lindex [$i eval set ::auto_path] 0] + set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token] + set accessList [lindex [safe::interpConfigure $i -accessPath] 1] + set autoList [lindex [safe::interpConfigure $i -autoPath] 1] + return [list [lindex $accessList 0] [lindex $autoList 0] $auto0] +} -cleanup { + set ::auto_path $::auto_TMP + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [info library] [info library] [info library]] +test safe-14.3 {Check that first element of child auto_path (and access path) is Tcl Library, even if not true for parent, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } + + set lib1 [info library] + set lib2 [file dirname $lib1] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib2 $lib1] + # Unexpected order, should be reversed in the child + + set i [safe::interpCreate] +} -body { + set autoList {} + set token [lindex [$i eval set ::auto_path] 0] + set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token] + set accessList [lindex [safe::interpConfigure $i -accessPath] 1] + + return [list [lindex $accessList 0] $auto0] +} -cleanup { + set ::auto_path $::auto_TMP + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [info library] [info library]] +test safe-14.3.1 {Check that first element of child auto_path (and access path) is Tcl Library, even if not true for parent, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + + set lib1 [info library] + set lib2 [file dirname $lib1] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib2 $lib1] + # Unexpected order, should be reversed in the child + + set i [safe::interpCreate] +} -body { + set autoList {} + set token [lindex [$i eval set ::auto_path] 0] + set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token] + set accessList [lindex [safe::interpConfigure $i -accessPath] 1] + set autoList [lindex [safe::interpConfigure $i -autoPath] 1] + + return [list [lindex $accessList 0] [lindex $autoList 0] $auto0] +} -cleanup { + set ::auto_path $::auto_TMP + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [info library] [info library] [info library]] + +### 15. Safe file ensemble. test safe-15.1 {safe file ensemble does not surprise code} -setup { set i [interp create -safe] @@ -1560,7 +1887,10 @@ test safe-15.2 {safe file ensemble does not surprise code} -setup { invoked from within "interp eval $i {file isdirectory .}"}} -### ~ should have no special meaning in paths in safe interpreters +### 16. ~ should have no special meaning in paths in safe interpreters. +### Defang it in glob. +### More tests of glob in sections 12, 13. + test safe-16.1 {Bug 3529949: defang ~ in paths} -setup { set savedHOME $env(HOME) set env(HOME) /foo/bar @@ -1654,10 +1984,1576 @@ test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup safe::interpDelete $i unset user } -result {~USER} + +### 17. Test the use of ::auto_path for loading commands (via tclIndex files) +### and non-module packages (via pkgIndex.tcl files). +### Corresponding tests with Sync Mode on are 7.* + +test safe-17.1 {cf. safe-7.1 - positive non-module package require, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + # Without AutoPathSync, we need a more complete auto_path, + # because the child will use the same value. + set lib1 [info library] + set lib2 [file join $TestsDir auto0] + set ::auto_TMP $::auto_path + set ::auto_path [list $lib1 $lib2] + + set i [safe::interpCreate] + set ::auto_path $::auto_TMP +} -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a child works like in the parent) + set v [interp eval $i {package require SafeTestPackage1}] + # no error shall occur: + interp eval $i HeresPackage1 + set v +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result 1.2.3 +test safe-17.2 {cf. safe-7.2 - negative non-module package require with specific path and interpAddToAccessPath, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not have been set by Safe Base: + set auto1 [interp eval $i {set ::auto_path}] + # This does not change the value of option -autoPath: + interp eval $i {set ::auto_path [list {$p(:0:)}]} + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if parent has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # should add as p* (not p2 if parent has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] + # an error shall occur (SafeTestPackage1 is not in auto0 but a subdirectory) + list $auto1 $token1 $token2 $token3 \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)}\ + 1 {can't find package SafeTestPackage1}\ + {-accessPath {[list $tcl_library \ + */dummy/unixlike/test/path \ + $TestsDir/auto0]}\ + -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}" +# (not a counterpart of safe-7.3) +test safe-17.3 {Check that default auto_path is the same as in the parent interpreter, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate] +} -body { + # This file's header sets auto_path to a single directory [info library], + # which is the one required by Safe Base to be present & first in the list. + set ap {} + foreach token [$i eval set ::auto_path] { + lappend ap [dict get [set ::safe::S${i}(access_path,map)] $token] + } + return [list $ap [lindex [::safe::interpConfigure $i -autoPath] 1]] +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list $::auto_path $::auto_path] +test safe-17.4 {cf. safe-7.4 - positive non-module package require with specific path and interpAddToAccessPath, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + + # should not have been set by Safe Base: + set auto1 [interp eval $i {set ::auto_path}] + + # This does not change the value of option -autoPath. + interp eval $i {set ::auto_path [list {$p(:0:)}]} + + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + + # should add as p* (not p1 if parent has a module path) + set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] + + # should add as p* (not p2 if parent has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]] + + # should not have been changed by Safe Base: + set auto2 [interp eval $i {set ::auto_path}] + + set auto3 [interp eval $i [list set ::auto_path [list {$p(:0:)} $token2]]] + + # This time, unlike test safe-17.2 and the try above, SafeTestPackage1 should be found: + list $auto1 $auto2 $token1 $token2 $token3 \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 0 1.2.3\ + {-accessPath {[list $tcl_library *$TestsDir/auto0 $TestsDir/auto0/auto1]}\ + -statics 0 -nested 1 -deleteHook {}\ + -autoPath {}} {}" +test safe-17.5 {cf. safe-7.5 - positive and negative module package require, including ancestor directory issue, Sync Mode off} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + tcl::tm::path add [file join $TestsDir auto0 modules] + set i [safe::interpCreate] + tcl::tm::path remove [file join $TestsDir auto0 modules] + interp eval $i { + package forget mod1::test1 + catch {namespace delete ::mod1} + } +} -body { + # Should raise an error (tests module ancestor directory rule) + set code1 [catch {interp eval $i {package require test1}} msg1] + # Should not raise an error + set code2 [catch {interp eval $i {package require mod1::test1}} msg2] + return [list $code1 $msg1 $code2] +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {1 {can't find package test1} 0} + +### 18. Test tokenization of directories available to a child. + +test safe-18.1 {Check that each directory of the default auto_path is a valid token, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } + set i [safe::interpCreate] +} -body { + set badTokens {} + foreach dir [$i eval {set ::auto_path}] { + if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} { + # Match - OK - token has expected form + } else { + # No match - possibly an ordinary path has not been tokenized + lappend badTokens $dir + } + } + set badTokens +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {} +test safe-18.1.1 {Check that each directory of the default auto_path is a valid token, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate] +} -body { + set badTokens {} + foreach dir [$i eval {set ::auto_path}] { + if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} { + # Match - OK - token has expected form + } else { + # No match - possibly an ordinary path has not been tokenized + lappend badTokens $dir + } + } + set badTokens +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {} +test safe-18.2 {Check that each directory of the module path is a valid token, Sync Mode on} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 1 + } + set i [safe::interpCreate] +} -body { + set badTokens {} + foreach dir [$i eval {::tcl::tm::path list}] { + if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} { + # Match - OK - token has expected form + } else { + # No match - possibly an ordinary path has not been tokenized + lappend badTokens $dir + } + } + set badTokens +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {} +test safe-18.2.1 {Check that each directory of the module path is a valid token, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate] +} -body { + set badTokens {} + foreach dir [$i eval {::tcl::tm::path list}] { + if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} { + # Match - OK - token has expected form + } else { + # No match - possibly an ordinary path has not been tokenized + lappend badTokens $dir + } + } + set badTokens +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {} + +### 19. Assorted options, including changes to option values. +### Mostly these are changes to access path, auto_path, module path. +### If Sync Mode is on, a corresponding test with Sync Mode off is 9.* + +test safe-19.8 {autoloading commands indexed in tclIndex files, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load and run the commands. + set code1 [catch {interp eval $i {report1}} msg1] + set code2 [catch {interp eval $i {report2}} msg2] + + list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA -- $mappC -- $toksC +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {{$p(:0:)} {$p(:1:)} {$p(:2:)}}} +test safe-19.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset), Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load auto_load data. + interp eval $i {catch nonExistentCommand} + + # Load and run the commands. + # This guarantees the test will pass even if the tokens are swapped. + set code1 [catch {interp eval $i {report1}} msg1] + set code2 [catch {interp eval $i {report2}} msg2] + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappD [mapList $PathMapp [dict get $confB -autoPath]] + set toksD [interp eval $i set ::auto_path] + + # Run the commands. + set code3 [catch {interp eval $i {report1}} msg3] + set code4 [catch {interp eval $i {report2}} msg4] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:1:)}}} +test safe-19.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset), Sync Mode off} -constraints {AutoSyncDefined} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load auto_load data. + interp eval $i {catch nonExistentCommand} + + # Do not load the commands. With the tokens swapped, the test + # will pass only if the Safe Base has called auto_reset. + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappD [mapList $PathMapp [dict get $confB -autoPath]] + set toksD [interp eval $i set ::auto_path] + + # Load and run the commands. + set code3 [catch {interp eval $i {report1}} msg3] + set code4 [catch {interp eval $i {report2}} msg4] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ + 0 ok1 0 ok2 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\ + {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:1:)}}} +test safe-19.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement (1), Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}. + # This would have no effect because the records in Pkg of these directories + # were from access as children of {$p(:1:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappD [mapList $PathMapp [dict get $confB -autoPath]] + set toksD [interp eval $i set ::auto_path] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD -- \ + $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\ + {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ + {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\ + {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)} {$p(:1:)}} --\ + 0 OK1 0 OK2} +test safe-19.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, safe-19.11 without path auto0, Sync Mode off} -constraints {AutoSyncDefined} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + # To manage without path auto0, use an auto_path that is unusual for + # package discovery. + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappD [mapList $PathMapp [dict get $confB -autoPath]] + set toksD [interp eval $i set ::auto_path] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD -- \ + $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ + 0 1.2.3 0 2.3.4 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1} --\ + {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:1:)} {$p(:2:)}} --\ + 0 OK1 0 OK2} +test safe-19.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, Sync Mode off} -constraints {AutoSyncDefined} -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + # Path auto0 added (cf. safe-9.3) because it is needed for auto_path. + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Limit access path. Remove tokens {$p(:2:)} and {$p(:3:)}. + safe::interpConfigure $i -accessPath [list $tcl_library] + + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4] + set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5] + set mappD [mapList $PathMapp [dict get $confB -autoPath]] + set toksD [interp eval $i set ::auto_path] + + # Try to load the packages. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3] + set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6] + + list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \ + $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:2:)} {$p(:3:)} -- 1 {* not found in access path} --\ + 1 {* not found in access path} -- 1 1 --\ + {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB*} -- {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\ + {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)}}} +# (no counterpart safe-9.14) +test safe-19.14 {when interpConfigure changes the access path, ::auto_path uses -autoPath value and new tokens, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + # Test that although -autoPath is unchanged, the child's ::auto_path changes to + # reflect the changes in token mappings. + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:3:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappD [mapList $PathMapp [dict get $confA -autoPath]] + set toksD [interp eval $i set ::auto_path] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path0 $path1 $path2 -- $path5 $path3 $path4 -- $toksC -- $toksD -- \ + $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} {$p(:1:)} -- {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)} {$p(:3:)}} -- 0 1.2.3 0 2.3.4 --\ + {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1 TESTSDIR/auto0*} --\ + {TCLLIB TESTSDIR/auto0} --\ + {TCLLIB TESTSDIR/auto0} --\ + 0 OK1 0 OK2} +# (no counterpart safe-9.15) +test safe-19.15 {when interpConfigure changes the access path, ::auto_path uses -autoPath value and new tokens, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + # Test that although -autoPath is unchanged, the child's ::auto_path changes to + # reflect the changes in token mappings; and that it is based on the -autoPath + # value, not the previously restricted child ::auto_path. + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0]] \ + -autoPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + # Inspect. + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Add more directories. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + set mappD [mapList $PathMapp [dict get $confA -autoPath]] + set toksD [interp eval $i set ::auto_path] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path0 -- $path5 $path3 $path4 -- $toksC -- $toksD -- \ + $code3 $msg3 $code4 $msg4 -- \ + $mappA -- $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} -- {$p(:1:)} {$p(:2:)} {$p(:3:)} -- {{$p(:0:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:3:)}} -- 0 1.2.3 0 2.3.4 --\ + {TCLLIB TESTSDIR/auto0*} --\ + {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\ + 0 OK1 0 OK2} +# (no counterpart safe-9.16) +test safe-19.16 {default value for -accessPath and -autoPath on creation; -autoPath preserved when -accessPath changes, ::auto_path using changed tokens, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set tmpAutoPath $::auto_path + set ::auto_path [list $tcl_library [file join $TestsDir auto0]] + set i [safe::interpCreate] + set ::auto_path $tmpAutoPath +} -body { + # Test that the -autoPath acquires and keeps the parent's value unless otherwise specified. + + # Inspect. + set confA [safe::interpConfigure $i] + set mappC [mapList $PathMapp [dict get $confA -autoPath]] + set toksC [interp eval $i set ::auto_path] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Remove a directory. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto1]] + # Inspect. + set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set mappD [mapList $PathMapp [dict get $confA -autoPath]] + set toksD [interp eval $i set ::auto_path] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4] + set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5] + set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6] + + list $path5 $path3 -- [lindex $toksC 0] [llength $toksC] -- \ + $toksD -- $code3 $msg3 $code4 $msg4 -- \ + $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:0:)} 2 --\ + {{$p(:0:)} {$p(:1:)}} -- 0 1.2.3 1 {can't find package SafeTestPackage2} --\ + {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1*} --\ + {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\ + 0 OK1 1 {invalid command name "HeresPackage2"}} +test safe-19.20 {check module loading, Sync Mode off} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} -- res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-19.21 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 1} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Load pkg data. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-19.22 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 0} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-19.23 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 3} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Force the interpreter to acquire pkg data which will soon become stale. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Refresh stale pkg data. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. +test safe-19.24 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 2 (worst case)} -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Force the interpreter to acquire pkg data which will soon become stale. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + # Inspect. + set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + [lsort [list $path3 $path4 $path5]] -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. + + +### 20. safe::interpCreate with different cases of -accessPath, -autoPath. + +set ::auto_path [list $tcl_library [file dirname $tcl_library] [file join $TestsDir auto0]] + +test safe-20.1 "create -accessPath NULL -autoPath NULL -> parent's ::auto_path" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list $::auto_path -- $::auto_path] +test safe-20.2 "create -accessPath {} -autoPath NULL -> parent's ::auto_path" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath {}] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list $::auto_path -- $::auto_path] +test safe-20.3 "create -accessPath path1 -autoPath NULL -> {}" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1]] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {{} -- {}} +test safe-20.4 "create -accessPath NULL -autoPath {} -> {}" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -autoPath {}] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {{} -- {}} +test safe-20.5 "create -accessPath {} -autoPath {} -> {}" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath {} -autoPath {}] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {{} -- {}} +test safe-20.6 "create -accessPath path1 -autoPath {} -> {}" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath {}] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {{} -- {}} +test safe-20.7 "create -accessPath NULL -autoPath path2 -> path2" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -autoPath [lrange $::auto_path 0 0]] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]] +test safe-20.8 "create -accessPath {} -autoPath path2 -> path2" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath {} -autoPath [lrange $::auto_path 0 0]] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]] +test safe-20.9 "create -accessPath path1 -autoPath path2 -> path2" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]] +test safe-20.10 "create -accessPath NULL -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -autoPath /not/in/access/path] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {/not/in/access/path -- {}} +test safe-20.11 "create -accessPath {} -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath {} -autoPath /not/in/access/path] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {/not/in/access/path -- {}} +test safe-20.12 "create -accessPath path1 -autoPath pathX -> {pathX}" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } +} -body { + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath /not/in/access/path] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {/not/in/access/path -- {}} + +### 21. safe::interpConfigure with different cases of -accessPath, -autoPath. + +test safe-21.1 "interpConfigure -accessPath NULL -autoPath NULL -> no change" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -deleteHook {} + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]] +test safe-21.2 "interpConfigure -accessPath {} -autoPath NULL -> parent's ::auto_path" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -accessPath {} + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list $::auto_path -- $::auto_path] +test safe-21.3 "interpConfigure -accessPath path1 -autoPath NULL -> no change" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -accessPath [lrange $::auto_path 0 1] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]] +test safe-21.4 "interpConfigure -accessPath NULL -autoPath {} -> {}" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -autoPath {} + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {{} -- {}} +test safe-21.5 "interpConfigure -accessPath {} -autoPath {} -> {}" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -accessPath {} -autoPath {} + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {{} -- {}} +test safe-21.6 "interpConfigure -accessPath {path1} -autoPath {} -> {}" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -accessPath [lrange $::auto_path 1 1] -autoPath {} + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {{} -- {}} +test safe-21.7 "interpConfigure -accessPath NULL -autoPath path2 -> path2" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -autoPath [lrange $::auto_path 1 1] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]] +test safe-21.8 "interpConfigure -accessPath {} -autoPath path2 -> path2" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -accessPath {} -autoPath [lrange $::auto_path 1 1] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]] +test safe-21.9 "interpConfigure -accessPath path1 -autoPath path2 -> path2" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -accessPath [lrange $::auto_path 0 2] -autoPath [lrange $::auto_path 1 1] + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]] +test safe-21.10 "interpConfigure -accessPath NULL -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -autoPath /not/in/access/path + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {/not/in/access/path -- {}} +test safe-21.11 "interpConfigure -accessPath {} -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -accessPath {} -autoPath /not/in/access/path + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {/not/in/access/path -- {}} +test safe-21.12 "interpConfigure -accessPath path1 -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup { + set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}] + if {$SyncExists} { + set SyncVal_TMP [safe::setSyncMode] + safe::setSyncMode 0 + } else { + error {This test is meaningful only if the command ::safe::setSyncMode is defined} + } + set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]] +} -body { + safe::interpConfigure $i -accessPath [lrange $::auto_path 0 2] -autoPath /not/in/access/path + getAutoPath $i +} -cleanup { + safe::interpDelete $i + if {$SyncExists} { + safe::setSyncMode $SyncVal_TMP + } +} -result {/not/in/access/path -- {}} # cleanup set ::auto_path $SaveAutoPath unset SaveAutoPath TestsDir PathMapp +rename getAutoPath {} unset -nocomplain path rename mapList {} rename mapAndSortList {} diff --git a/tests/scan.test b/tests/scan.test index c6e7922..cf58828 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -508,7 +508,7 @@ test scan-5.10 {integer scanning} -setup { list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d } -result {2 1 2 {} {}} # -# The behavior for scaning intergers larger than MAX_INT is not defined by the +# The behavior for scanning integers larger than MAX_INT is not defined by the # ANSI spec. Some implementations wrap the input (-16) some return MAX_INT. # test scan-5.11 {integer scanning} -constraints {nonPortable} -setup { @@ -605,7 +605,7 @@ test scan-6.8 {floating-point scanning} -setup { } -body { list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d } -result {2 4.6 5.2 {} {}} -test scan-6.8 {disallow diget separator in floating-point} -setup { +test scan-6.9 {disallow diget separator in floating-point} -setup { set a {}; set b {}; set c {}; } -body { list [scan "3.14_2.35_98.6" %f_%f_%f a b c ] $a $b $c diff --git a/tests/socket.test b/tests/socket.test index 4644e1d..82e908a 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -127,7 +127,7 @@ set t2 [clock milliseconds] set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin # Test the latency of failed connection attempts over the loopback -# interface. They can take more than a second under Windowos and requres +# interface. They can take more than a second under Windows and requires # additional [after]s in some tests that are not needed on systems that fail # immediately. set t1 [clock milliseconds] @@ -308,13 +308,13 @@ test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket s } -returnCodes error -result {no argument given for -server option} test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server foo -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myaddr } -returnCodes error -result {no argument given for -myaddr option} test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myaddr $localhost -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myport } -returnCodes error -result {no argument given for -myport option} @@ -323,19 +323,19 @@ test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket s } -returnCodes error -result {expected integer but got "xxxx"} test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -myport 2522 -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -froboz -} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, -reuseaddr, -reuseport, or -server} +} -returnCodes error -result {bad option "-froboz": must be -async, -backlog, -myaddr, -myport, -reuseaddr, -reuseport, or -server} test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server foo -myport 2521 3333 } -returnCodes error -result {option -myport is not valid for servers} test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket host 2528 -junk -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -server callback 2520 -- -} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"} +} -returnCodes error -result {wrong # args: should be "socket ?-async? ?-myaddr addr? ?-myport myport? host port" or "socket -server command ?-backlog count? ?-myaddr addr? ?-reuseaddr boolean? ?-reuseport boolean? port"} test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket foo badport } -returnCodes error -result {expected integer but got "badport"} @@ -347,19 +347,19 @@ test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket } -returnCodes error -result {cannot set -async option for server sockets} test socket_$af-1.15 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseaddr yes 4242 -} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers} +} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers} test socket_$af-1.16 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseaddr no 4242 -} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers} +} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers} test socket_$af-1.17 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseaddr } -returnCodes error -result {no argument given for -reuseaddr option} test socket_$af-1.18 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseport yes 4242 -} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers} +} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers} test socket_$af-1.19 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseport no 4242 -} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers} +} -returnCodes error -result {options -backlog, -reuseaddr, and -reuseport are only valid for servers} test socket_$af-1.20 {arg parsing for socket command} -constraints [list socket supported_$af] -body { socket -reuseport } -returnCodes error -result {no argument given for -reuseport option} @@ -1071,7 +1071,7 @@ test socket_$af-7.3 {testing socket specific options} -constraints [list socket close $s update llength $l -} -result 14 +} -result 20 test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup { set timer [after 10000 "set x timed_out"] set l "" @@ -1864,7 +1864,7 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} { set srvsock {} # if binding on port 0 is not possible (system related, blocked on ISPs etc): if {[catch {close [socket -async $::localhost $port]}]} { - # simplest server on random port (immediatelly closing a connect): + # simplest server on random port (immediately closing a connect): set port [randport] set srvsock [socket -server {apply {{ch args} {close $ch}}} -myaddr $::localhost $port] # socket on windows has some issues yet (e. g. bug [b6d0d8cc2c]), so we simply decrease iteration count (to 1/4): @@ -1898,7 +1898,7 @@ proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} { } iteration first } - # parent proc commiting transfer attempt (attach) and checking acquire was successful: + # parent proc committing transfer attempt (attach) and checking acquire was successful: proc transf_parent {fd args} { tcltest::DebugPuts 2 "** trma / $::count ** $args **" thread::attach $fd @@ -2226,7 +2226,7 @@ test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \ list $x [fconfigure $sock -error] [fconfigure $sock -error] } -cleanup { close $sock - } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} + } -match glob -result {{error reading "sock*": transport endpoint is not connected} {connection refused} {}} test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \ -constraints {socket supported_inet localhost_v4} \ -setup { @@ -2291,7 +2291,7 @@ test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} list $x [fconfigure $sock -error] [fconfigure $sock -error] } -cleanup { close $sock - } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}} + } -match glob -result {{error reading "sock*": transport endpoint is not connected} {connection refused} {}} test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \ -constraints {socket supported_inet localhost_v4} \ -setup { @@ -2406,7 +2406,7 @@ test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener } -cleanup { catch {close $sock} unset x - } -result {socket is not connected} -returnCodes 1 + } -result {transport endpoint is not connected} -returnCodes 1 test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \ -constraints {socket testsocket_testflags} \ -body { @@ -2425,7 +2425,7 @@ test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener } -cleanup { catch {close $sock} catch {unset x} - } -result {socket is not connected} -returnCodes 1 + } -result {transport endpoint is not connected} -returnCodes 1 test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \ -constraints {socket} \ -body { @@ -2447,7 +2447,7 @@ test socket-14.13 {testing writable event when quick failure} \ # Test for bug 336441ed59 where a quick background fail was ignored # Test only for windows as socket -async 255.255.255.255 fails - # directly on unix + # directly on Unix # The following connect should fail very quickly set a1 [after 2000 {set x timeout}] diff --git a/tests/string.test b/tests/string.test index ba5be14..ade673e 100644 --- a/tests/string.test +++ b/tests/string.test @@ -19,7 +19,8 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] + # Helper commands to test various optimizations, code paths, and special cases. proc makeByteArray {s} {binary format a* $s} @@ -133,7 +134,7 @@ test string-2.11.3.$noComp {string compare, unicode} { run {string compare ÜÜÜüü ÜÜÜÜÜ} } 1 test string-2.12.$noComp {string compare, high bit} { - # This test will fail if the underlying comparison + # This test fails if the underlying comparison # is using signed chars instead of unsigned chars. # (like SunOS's default memcmp thus the compat/memcmp.c) run {string compare "\x80" "@"} @@ -197,10 +198,10 @@ test string-2.26.$noComp {string compare -nocase, null strings} { test string-2.27.$noComp {string compare -nocase, null strings} { run {string compare -nocase foo ""} } 1 -test string-2.28.$noComp {string compare with length, unequal strings} { +test string-2.28.$noComp {string compare with length, unequal strings, partial first string} { run {string compare -length 2 abc abde} } 0 -test string-2.29.$noComp {string compare with length, unequal strings} { +test string-2.29.$noComp {string compare with length, unequal strings 2, full first string} { run {string compare -length 2 ab abde} } 0 test string-2.30.$noComp {string compare with NUL character vs. other ASCII} { @@ -288,7 +289,7 @@ test string-3.19.$noComp {string equal, unicode} { run {string equal ÜÜÜüü ÜÜÜÜÜ} } 0 test string-3.20.$noComp {string equal, high bit} { - # This test will fail if the underlying comparison + # This test fails if the underlying comparison # is using signed chars instead of unsigned chars. # (like SunOS's default memcmp thus the compat/memcmp.c) run {string equal "\x80" "@"} diff --git a/tests/stringObj.test b/tests/stringObj.test index 0c65cdc..60e1294 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] @@ -69,8 +69,8 @@ test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {testobj dep testobj freeallvars teststringobj set 1 abcdef teststringobj setlength 1 10 - list [teststringobj length 1] [teststringobj length2 1] -} {10 10} + teststringobj length 1 +} 10 test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {testobj utf32 deprecated} { testobj freeallvars teststringobj set 1 abcdef @@ -78,7 +78,7 @@ test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {testobj utf list [teststringobj length 1] [teststringobj length2 1] \ [teststringobj get 1] } {10 10 abcdefxyzq} -test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {testobj deprecated} { +test stringObj-4.4 {Tcl_SetObjLength procedure, "empty string", length 0} {testobj deprecated} { testobj freeallvars testobj newobj 1 teststringobj setlength 1 0 @@ -317,7 +317,7 @@ test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} testobj { test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj { # bug 2678, in <=8.2.0, the second obj (the one to append) in # Tcl_AppendObjToObj was not correctly checked to see if it was all one - # byte chars, so a unicode string would be added as one byte chars. + # byte chars, so a Unicode string would be added as one byte chars. set x abcdef set len [string length $x] set y a\xFCb\xE5c\xEF @@ -410,13 +410,13 @@ test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj { } 1 test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj { # string length "￮￮" - # Use \uXXXX notation below instead of hardcoding the values, otherwise + # Use \uXXXX notation below instead of hard-coding the values, otherwise # the test will fail in multibyte locales. string length "\xEF\xBF\xAE\xEF\xBF\xAE" } 6 test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj { # set a "ïa¿b®cï¿d®" - # Use \uXXXX notation below instead of hardcoding the values, otherwise + # Use \uXXXX notation below instead of hard-coding the values, otherwise # the test will fail in multibyte locales. set a "\xEFa\xBFb\xAEc\xEF\xBFd\xAE" list [string length $a] [string length $a] diff --git a/tests/tcltest.test b/tests/tcltest.test index a9ce785..114ce30 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -22,6 +22,9 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +# File permissions broken on wsl without some "exotic" wsl configuration +testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] + namespace eval ::tcltest::test { namespace import ::tcltest::* @@ -306,7 +309,7 @@ test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)} { #} test tcltest-5.5 {InitConstraints: list of built-in constraints} \ - -constraints {!singleTestInterp} \ + -constraints {!singleTestInterp notWsl} \ -setup {tcltest::InitConstraints} \ -body { lsort [array names ::tcltest::testConstraints] } \ -result [lsort { @@ -539,24 +542,24 @@ test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} { -result {*not a directory*} -match glob } -# Test non-writeable directories, non-readable directories with directory flags +# Test non-writable directories, non-readable directories with directory flags set notReadableDir [file join [temporaryDirectory] notreadable] -set notWriteableDir [file join [temporaryDirectory] notwriteable] +set notWritableDir [file join [temporaryDirectory] notwritable] makeDirectory notreadable -makeDirectory notwriteable +makeDirectory notwritable switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 0o333 - file attributes $notWriteableDir -permissions 0o555 + file attributes $notWritableDir -permissions 0o555 } default { # note in FAT/NTFS we won't be able to protect directory with read-only attribute... - catch {file attributes $notWriteableDir -readonly 1} - catch {testchmod 0 $notWriteableDir} + catch {file attributes $notWritableDir -readonly 1} + catch {testchmod 0o444 $notWritableDir} } } test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} { - -constraints {unix notRoot} + -constraints {unix notRoot notWsl} -body { child msg $a -tmpdir $notReadableDir return $msg @@ -567,17 +570,17 @@ test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} { # This constraint doesn't go at the top of the file so that it doesn't # interfere with tcltest-5.5 testConstraint notFAT [expr { - ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]] + ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWritableDir] 1]] || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]] }] # FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used -test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} { - -constraints {unixOrWin notRoot notFAT} +test tcltest-8.4 {tcltest a.tcl -tmpdir notWritableDir} { + -constraints {unixOrWin notRoot notFAT notWsl} -body { - child msg $a -tmpdir $notWriteableDir + child msg $a -tmpdir $notWritableDir return $msg } - -result {*not writeable*} + -result {*not writable*} -match glob } test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} { @@ -645,7 +648,7 @@ test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} { -result {*not a directory*} } test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} { - -constraints {unix notRoot} + -constraints {unix notRoot notWsl} -body { child msg $a -testdir $notReadableDir return $msg @@ -717,15 +720,15 @@ test tcltest-8.60 {::workingDirectory} { switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 0o777 - file attributes $notWriteableDir -permissions 0o777 + file attributes $notWritableDir -permissions 0o777 } default { - catch {testchmod 0o777 $notWriteableDir} - catch {file attributes $notWriteableDir -readonly 0} + catch {testchmod 0o777 $notWritableDir} + catch {file attributes $notWritableDir -readonly 0} } } -file delete -force -- $notReadableDir $notWriteableDir +file delete -force -- $notReadableDir $notWritableDir removeFile a.tcl removeFile thisdirectoryisafile removeDirectory normaldirectory diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index cc0d6a7..61366a4 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -1,5 +1,8 @@ #! /usr/bin/env tclsh +# Don't overwrite tcltests facilities already present +if {[package provide tcltests] ne {}} return + package require tcltest 2.5 namespace import ::tcltest::* testConstraint exec [llength [info commands exec]] @@ -31,6 +34,18 @@ namespace eval ::tcltests { } + # Stolen from dict.test + proc scriptmemcheck script { + set end [lindex [split [memory info] \n] 3 3] + for {set i 0} {$i < 5} {incr i} { + uplevel 1 $script + set tmp $end + set end [lindex [split [memory info] \n] 3 3] + } + expr {$end - $tmp} + } + + proc tempdir_alternate {} { close [file tempfile tempfile] set tmpdir [file dirname $tempfile] diff --git a/tests/thread.test b/tests/thread.test index 16e60ed..636d7a8 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -19,9 +19,11 @@ if {"::tcltest" ni [namespace children]} { # when thread::release is used, -wait is passed in order allow the thread to # be fully finalized, which avoids valgrind "still reachable" reports. +package require tcltest 2.5 +source [file join [file dirname [info script]] tcltests.tcl] + ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests # Some tests require the testthread command diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test index 3eade4a..09a34dd 100644 --- a/tests/unixFCmd.test +++ b/tests/unixFCmd.test @@ -18,13 +18,15 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testchmod [llength [info commands testchmod]] +# File permissions broken on wsl without some "exotic" wsl configuration +testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] # These tests really need to be run from a writable directory, which # it is assumed [temporaryDirectory] is. set oldcwd [pwd] cd [temporaryDirectory] -# Several tests require need to match results against the unix username +# Several tests require need to match results against the Unix username set user {} if {[testConstraint unix]} { catch {set user [exec whoami]} @@ -94,7 +96,7 @@ if {[testConstraint unix] && [testConstraint notRoot]} { test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup { cleanup -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir td1/td2/td3 file attributes td1/td2 -permissions 0 file rename td1/td2/td3 td2 @@ -110,7 +112,7 @@ test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup { file rename td2 td1 } -returnCodes error -cleanup { cleanup -} -result {error renaming "td2" to "td1/td2": file already exists} +} -result {error renaming "td2" to "td1/td2": file exists} test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup { cleanup } -constraints {unix notRoot} -body { @@ -135,7 +137,7 @@ test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} { } {} test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup { cleanup -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { file mkdir foo/bar file attr foo -perm 0o40555 file rename foo/bar /tmp @@ -219,7 +221,7 @@ test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup { } -result {fifo fifo} test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup { cleanup -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { close [open tf1 a] file attributes tf1 -permissions 0o472 file copy tf1 tf2 @@ -334,7 +336,7 @@ test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} -setup { test unixFCmd-17.1 {SetPermissionsAttribute} -setup { catch {file delete -force -- foo.test} -} -constraints {unix notRoot} -body { +} -constraints {unix notRoot notWsl} -body { close [open foo.test w] list [file attributes foo.test -permissions 0] \ [file attributes foo.test -permissions] @@ -366,7 +368,7 @@ test unixFCmd-17.4 {SetPermissionsAttribute} -setup { close [open foo.test w] set ::i 4 proc permcheck {testnum permList expected} { - test $testnum {SetPermissionsAttribute} {unix notRoot} { + test $testnum {SetPermissionsAttribute} {unix notRoot notWsl} { set result {} foreach permstr $permList { file attributes foo.test -permissions $permstr @@ -385,7 +387,7 @@ file delete -force -- foo.test test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup { set cd [pwd] } -body { - # This test is nonPortable because SunOS generates a weird error + # This test is non-portable because SunOS generates a weird error # message when the current directory isn't readable. set nd $cd/tstdir file mkdir $nd diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test index f321b10..bf22449 100644 --- a/tests/unixForkEvent.test +++ b/tests/unixForkEvent.test @@ -17,7 +17,7 @@ testConstraint testfork [llength [info commands testfork]] # Test if the notifier thread is well initialized in a forked interpreter # by Tcl_InitNotifier -test unixforkevent-1.1 {fork and test writeable event} \ +test unixforkevent-1.1 {fork and test writable event} \ -constraints {testfork nonPortable} \ -body { set myFolder [makeDirectory unixtestfork] diff --git a/tests/unixInit.test b/tests/unixInit.test index 2ea7d8e..8e64c7a 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -346,7 +346,9 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints { } -match regexp -result {^(iso8859-15?|utf-8)$} test unixInit-3.2 {TclpSetInitialEncodings} -setup { catch {set oldlc_all $env(LC_ALL)} -} -constraints {unix stdio} -body { + catch {set oldtcl_library $env(TCL_LIBRARY)} + unset -nocomplain env(TCL_LIBRARY) +} -constraints {unix stdio knownBug} -body { set env(LANG) japanese set env(LC_ALL) japanese set f [open "|[list [interpreter]]" w+] @@ -364,6 +366,7 @@ test unixInit-3.2 {TclpSetInitialEncodings} -setup { } -cleanup { unset -nocomplain env(LANG) env(LC_ALL) catch {set env(LC_ALL) $oldlc_all} + catch {set env(TCL_LIBRARY) $oldtcl_library} } -result 0 test unixInit-4.1 {TclpSetVariables} {unix} { diff --git a/tests/utf.test b/tests/utf.test index 60596f7..5a6bbd4 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}] testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] diff --git a/tests/utfext.test b/tests/utfext.test new file mode 100644 index 0000000..bc996c9 --- /dev/null +++ b/tests/utfext.test @@ -0,0 +1,101 @@ +# This file contains a collection of tests for Tcl_UtfToExternal and +# Tcl_UtfToExternal. Sourcing this file into Tcl runs the tests and generates +# errors. No output means no errors found. +# +# Copyright (c) 2023 Ashok P. Nadkarni +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.5 + namespace import -force ::tcltest::* +} + +::tcltest::loadTestedCommands +catch [list package require -exact tcl::test [info patchlevel]] + +testConstraint testbytestring [llength [info commands testbytestring]] +testConstraint testencoding [llength [info commands testencoding]] + +# Maps encoded bytes string to utf-8 equivalents, both in hex +# encoding utf-8 encdata +lappend utfExtMap {*}{ + ascii 414243 414243 +} + +if {[info commands printable] eq ""} { + proc printable {s} { + set print "" + foreach c [split $s ""] { + set i [scan $c %c] + if {[string is print $c] && ($i <= 127)} { + append print $c + } elseif {$i <= 0xff} { + append print \\x[format %02X $i] + } elseif {$i <= 0xffff} { + append print \\u[format %04X $i] + } else { + append print \\U[format %08X $i] + } + } + return $print + } +} + +# Simple test with basic flags +proc testbasic {direction enc hexin hexout {flags {start end}}} { + if {$direction eq "toutf"} { + set cmd Tcl_ExternalToUtf + } else { + set cmd Tcl_UtfToExternal + } + set in [binary decode hex $hexin] + set out [binary decode hex $hexout] + set dstlen 40 ;# Should be enough for all encoding tests + + # The C wrapper fills entire destination buffer with FF. + # Anything beyond expected output should have FF's + set filler [string repeat \xFF $dstlen] + set result [string range "$out$filler" 0 $dstlen-1] + test $cmd-$enc-$hexin-[join $flags -] "$cmd - $enc - $hexin - $flags" -body \ + [list testencoding $cmd $enc $in $flags {} $dstlen] \ + -result [list ok {} $result] + foreach profile [encoding profiles] { + set flags2 [linsert $flags end profile$profile] + test $cmd-$enc-$hexin-[join $flags2 -] "$cmd - $enc - $hexin - $flags" -body \ + [list testencoding $cmd $enc $in $flags2 {} $dstlen] \ + -result [list ok {} $result] + } +} + +# +# Basic tests +foreach {enc utfhex hex} $utfExtMap { + # Basic test - TCL_ENCODING_START|TCL_ENCODING_END + # Note by default output should be terminated with \0 + testbasic toutf $enc $hex ${utfhex}00 {start end} + testbasic fromutf $enc $utfhex ${hex}00 {start end} + + # Test TCL_ENCODING_NO_TERMINATE + testbasic toutf $enc $hex $utfhex {start end noterminate} + # knownBug - noterminate not obeyed by fromutf + # testbasic fromutf $enc $utfhex $hex {start end noterminate} +} + +# Test for insufficient space +test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -body { + testencoding Tcl_UtfToExternal ucs-2 A {start end} {} 1 +} -result [list nospace {} \xFF] + +# Another bug - char limit not obeyed +# % set cv 2 +# % testencoding Tcl_ExternalToUtf utf-8 abcdefgh {start end noterminate charlimit} {} 20 rv wv cv +# nospace {} abcÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ + +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/while-old.test b/tests/while-old.test index 9c8cacc..b5b69dc 100644 --- a/tests/while-old.test +++ b/tests/while-old.test @@ -92,7 +92,7 @@ test while-old-4.3 {errors in while loops} { test while-old-4.4 {errors in while loops} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test while-old-4.5 {errors in while loops} { catch {unset x} set x 1 diff --git a/tests/while.test b/tests/while.test index 6ea8548..2bfab2a 100644 --- a/tests/while.test +++ b/tests/while.test @@ -32,7 +32,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} -body { } -match glob -result {*"while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} -body { while {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-1.4 {TclCompileWhileCmd: multiline test expr} -body { set value 1 while {($tcl_platform(platform) != "foobar1") && \ @@ -343,7 +343,7 @@ test while-4.3 {while (not compiled): error in test expression} -body { test while-4.4 {while (not compiled): error in test expression} -body { set z while $z {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-4.5 {while (not compiled): multiline test expr} -body { set value 1 set z while diff --git a/tests/winConsole.test b/tests/winConsole.test index 821a143..f030444 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -198,7 +198,7 @@ test console-fconfigure-get-1.0 { Console get stdin configuration } -constraints {win interactive} -body { lsort [dict keys [fconfigure stdin]] -} -result {-blocking -buffering -buffersize -encoding -eofchar -inputmode -translation} +} -result {-blocking -buffering -buffersize -encoding -eofchar -inputmode -profile -translation} set testnum 0 foreach {opt result} { @@ -224,7 +224,7 @@ test console-fconfigure-get-1.[incr testnum] { fconfigure -winsize } -constraints {win interactive} -body { fconfigure stdin -winsize -} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -inputmode} -returnCodes error +} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -inputmode} -returnCodes error ## fconfigure get stdout/stderr foreach chan {stdout stderr} major {2 3} { @@ -232,7 +232,7 @@ foreach chan {stdout stderr} major {2 3} { win interactive } -body { lsort [dict keys [fconfigure $chan]] - } -result {-blocking -buffering -buffersize -encoding -eofchar -translation -winsize} + } -result {-blocking -buffering -buffersize -encoding -eofchar -profile -translation -winsize} set testnum 0 foreach {opt result} { -blocking 1 @@ -260,7 +260,7 @@ foreach chan {stdout stderr} major {2 3} { fconfigure -inputmode } -constraints {win interactive} -body { fconfigure $chan -inputmode - } -result {bad option "-inputmode": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -winsize} -returnCodes error + } -result {bad option "-inputmode": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -winsize} -returnCodes error } @@ -330,7 +330,7 @@ test console-fconfigure-set-1.3 { fconfigure stdin -winsize } -constraints {win interactive} -body { fconfigure stdin -winsize {10 30} -} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -inputmode} -returnCodes error +} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -inputmode} -returnCodes error ## fconfigure set stdout,stderr @@ -338,13 +338,13 @@ test console-fconfigure-set-2.0 { fconfigure stdout -winsize } -constraints {win interactive} -body { fconfigure stdout -winsize {10 30} -} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation} -returnCodes error +} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, or -translation} -returnCodes error test console-fconfigure-set-3.0 { fconfigure stderr -winsize } -constraints {win interactive} -body { fconfigure stderr -winsize {10 30} -} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation} -returnCodes error +} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -profile, -translation} -returnCodes error # Multiple threads diff --git a/tests/winDde.test b/tests/winDde.test index ad21426..93b9242 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -13,13 +13,13 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint dde 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - set ::ddever [package require dde 1.4.4] + set ::ddever [package require dde 1.4.5] set ::ddelib [info loaded {} Dde]}]} { testConstraint dde 1 } @@ -105,7 +105,7 @@ proc createChildProcess {ddeServerName args} { # ------------------------------------------------------------------------- test winDde-1.0 {check if we are testing the right dll} {win dde} { set ::ddever -} {1.4.4} +} {1.4.5} test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] @@ -154,15 +154,15 @@ test winDde-3.5 {DDE request locally} -constraints dde -body { dde execute TclEval self [list set \xe1 foo] dde request -binary TclEval self \xe1 } -result "foo\x00" -# Set variable a to A with diaeresis (unicode C4) by relying on the fact +# Set variable a to A with diaeresis (Unicode C4) by relying on the fact # that utf-8 is sent (e.g. "c3 84" on the wire) test winDde-3.6 {DDE request utf-8} -constraints dde -body { set \xe1 "not set" dde execute TclEval self "set \xe1 \xc4" scan [set \xe1] %c } -result 196 -# Set variable a to A with diaeresis (unicode C4) using binary execute -# and compose utf-8 (e.g. "c3 84" ) manualy +# Set variable a to A with diaeresis (Unicode C4) using binary execute +# and compose utf-8 (e.g. "c3 84" ) manually test winDde-3.7 {DDE request binary} -constraints {dde notWine} -body { set \xe1 "not set" dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00] diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 43c7ced..9b5e67e 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -45,15 +45,20 @@ proc contents {file} { set r } +proc cleanupRecurse {args} { + # Assumes no loops via links! + # Need to change permissions BEFORE deletion + testchmod 0o777 {*}$args + foreach victim $args { + if {[file isdirectory $victim]} { + cleanupRecurse {*}[glob -nocomplain -directory $victim td* tf* Test*] + } + file delete -force $victim + } +} proc cleanup {args} { - foreach p ". $args" { - set x "" - catch { - set x [glob -directory $p tf* td*] - } - if {$x != ""} { - catch {file delete -force -- {*}$x} - } + foreach p [list [pwd] {*}$args] { + cleanupRecurse {*}[glob -nocomplain -directory $p tf* td*] } } @@ -118,7 +123,7 @@ append longname $longname # Uses the "testfile" command instead of the "file" command. The "file" # command provides several layers of sanity checks on the arguments and # it can be difficult to actually forward "insane" arguments to the -# low-level posix emulation layer. +# low-level Posix emulation layer. test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body { testfile mv $cdfile $cdrom/dummy~~.fil @@ -245,8 +250,9 @@ test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup { test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup { cleanup } -constraints {win testfile} -body { + # Error code depends on Windows version testfile mv / c:/ -} -returnCodes error -result EINVAL +} -returnCodes error -result {^(EINVAL|ENOENT)$} -match regexp test winFCmd-1.25 {TclpRenameFile: cross file systems} -setup { cleanup } -constraints {win cdrom testfile} -body { @@ -379,12 +385,12 @@ test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup { cleanup } -constraints {win winNonZeroInodes knownMsvcBug notInCIenv} -body { file mkdir td1 - foreach {a b} [MakeFiles td1] break + lassign [MakeFiles td1] a b file rename -force $a $b file exists $a } -cleanup { cleanup -} -result {0} +} -result 0 test winFCmd-2.1 {TclpCopyFile: errno: EACCES} -setup { @@ -450,11 +456,11 @@ test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} -setup { cleanup } -constraints {win testfile} -body { createfile tf1 tf1 - testchmod 0 tf1 + file attribute tf1 -readonly 1 testfile cp tf1 tf2 list [contents tf2] [file writable tf2] } -cleanup { - catch {testchmod 0o666 tf1} + testchmod 0o660 tf1 cleanup } -result {tf1 0} test winFCmd-2.13 {TclpCopyFile: CopyFile fails} -setup { @@ -496,11 +502,10 @@ test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup { } -constraints {win testfile testchmod} -body { createfile tf1 tf1 createfile tf2 tf2 - testchmod 0 tf2 + file attribute tf2 -readonly 1 testfile cp tf1 tf2 list [file writable tf2] [contents tf2] } -cleanup { - catch {testchmod 0o666 tf2} cleanup } -result {1 tf1} @@ -578,7 +583,6 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup { testfile rm tf1 } -cleanup { close $fd - catch {testchmod 0o666 tf1} cleanup } -returnCodes error -result EACCES @@ -617,15 +621,18 @@ test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup { test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup { cleanup -} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body { - file mkdir td1 - testchmod 0 td1 - testfile rmdir td1 - file exists td1 +} -constraints {win testfile testchmod notInCIenv} -body { + # Parent's FILE_DELETE_CHILD setting permits deletion of subdir + # even when subdir DELETE mask is clear. So we need an intermediate + # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W. + file mkdir td0/td1 + testchmod 0o777 td0 + testchmod 0 td0/td1 + testfile rmdir td0/td1 + file exists td0/td1 } -returnCodes error -cleanup { - catch {testchmod 0o666 td1} cleanup -} -result {td1 EACCES} +} -result {td0/td1 EACCES} # This next test has a very hokey way of matching... test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup { cleanup @@ -633,7 +640,7 @@ test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup { file mkdir td1/td2 list [catch {testfile rmdir td1} msg] [file tail $msg] } -result {1 {td1 EEXIST}} -test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest} { +test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest trashSystem} { # can't test this w/o removing everything on your hard disk first! # testfile rmdir / } {} @@ -669,17 +676,7 @@ test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup { createfile tf1 list [catch {testfile rmdir tf1} msg] [file tail $msg] } -result {1 {tf1 ENOTDIR}} -test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup { - cleanup -} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body { - file mkdir td1 - testchmod 0 td1 - testfile rmdir td1 - file exists td1 -} -returnCodes error -cleanup { - catch {testchmod 0o666 td1} - cleanup -} -result {td1 EACCES} +# winFCmd-6.9 removed - was exact dup of winFCmd-6.1 test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup { cleanup } -constraints {win testfile notInCIenv} -body { @@ -689,15 +686,19 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup { } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$} test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup { cleanup -} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body { - file mkdir td1 - testchmod 0 td1 - testfile rmdir td1 - file exists td1 +} -constraints {win testfile testchmod notInCIenv} -body { + # Parent's FILE_DELETE_CHILD setting permits deletion of subdir + # even when subdir DELETE mask is clear. So we need an intermediate + # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W. + file mkdir td0/td1 + testchmod 0o770 td0 + testchmod 0o444 td0/td1 + testfile rmdir td0/td1 + file exists td0/td1 } -cleanup { - catch {testchmod 0o666 td1} + testchmod 0o770 td0/td1 cleanup -} -returnCodes error -result {td1 EACCES} +} -returnCodes error -result {td0/td1 EACCES} # This next test has a very hokey way of matching... test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup { cleanup @@ -791,11 +792,12 @@ test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup { } -constraints {win testfile testchmod} -body { file mkdir td1 createfile td1/tf1 tf1 - testchmod 0 td1 + testchmod 0o770 td1/tf1; # Else tf2 will have no ACL after td1 testchmod + testchmod 0o400 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } -cleanup { - catch {testchmod 0o666 td1} + testchmod 0o660 td1 cleanup } -result {1 1} test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} -setup { @@ -862,11 +864,12 @@ test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} -setup { } -constraints {win testfile testchmod} -body { file mkdir td1 createfile td1/tf1 tf1 - testchmod 0 td1 + testchmod 0o770 td1/tf1; # Else tf2 will have no ACL after td1 testchmod + testchmod 0o400 td1 testfile cpdir td1 td2 list [file exists td2] [file writable td2] } -cleanup { - catch {testchmod 0o666 td1} + testchmod 0o660 td1 cleanup } -result {1 1} test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} -setup { @@ -893,11 +896,12 @@ test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} -setup { cleanup } -constraints {win testfile testchmod} -body { file mkdir td1/td2 - testchmod 0 td1 + testchmod 0o770 td1/td2; # Else td2 will have no ACL after td1 testchmod + testchmod 0o400 td1 testfile cpdir td1 td2 list [file writable td1] [file writable td1/td2] } -cleanup { - catch {testchmod 0o666 td1} + testchmod 0o660 td1 cleanup } -result {0 1} test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} -setup { @@ -918,15 +922,19 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup { } -result {} test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup { cleanup -} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body { - file mkdir td1/td2 - testchmod 0 td1 - testfile rmdir -force td1 +} -constraints {win testfile testchmod notInCIenv} -body { + # Parent's FILE_DELETE_CHILD setting permits deletion of subdir + # even when subdir DELETE mask is clear. So we need an intermediate + # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W. + file mkdir td0/td1/td2 + testchmod 0o770 td0 + testchmod 0o400 td0/td1 + testfile rmdir -force td0/td1 file exists td1 } -cleanup { - catch {testchmod 0o666 td1} + testchmod 0o770 td0/td1 cleanup -} -returnCodes error -result {td1 EACCES} +} -returnCodes error -result {td0/td1 EACCES} test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} -setup { cleanup } -constraints {win testfile} -body { @@ -1417,7 +1425,6 @@ test winFCmd-19.9 {Windows devices path names} -constraints win -body { # } #} -# cleanup cleanup ::tcltest::cleanupTests return diff --git a/tests/winTime.test b/tests/winTime.test index ae1797d..0d7298f 100644 --- a/tests/winTime.test +++ b/tests/winTime.test @@ -19,9 +19,6 @@ if {"::tcltest" ni [namespace children]} { catch [list package require -exact tcl::test [info patchlevel]] testConstraint testwinclock [llength [info commands testwinclock]] -# Some things fail under all Continuous Integration systems for subtle reasons -# such as CI often running with elevated privileges in a container. -testConstraint notInCIenv [expr {![info exists ::env(CI)]}] # The next two tests will crash on Windows if the check for negative # clock values is not done properly. @@ -43,7 +40,7 @@ test winTime-1.2 {TclpGetDate} {win} { # with the Windows clock. 30 sec really isn't enough, # but how much time does a tester have patience for? -test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock notInCIenv} { +test winTime-2.1 {Synchronization of Tcl and Windows clocks} testwinclock { # May fail due to OS/hardware discrepancies. See: # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 set failed {} diff --git a/tests/zlib.test b/tests/zlib.test index 7de6d64..42d9e9c 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -286,23 +286,23 @@ test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup { test zlib-8.6 {transformation and fconfigure} -setup { set file [makeFile {} test.z] set fd [open $file wb] -} -constraints zlib -body { +} -constraints {zlib deprecated} -body { list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \ [chan pop $fd; fconfigure $fd] } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf}} test zlib-8.7 {transformation and fconfigure} -setup { set file [makeFile {} test.gz] set fd [open $file wb] -} -constraints zlib -body { +} -constraints {zlib deprecated} -body { list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \ [chan pop $fd; fconfigure $fd] } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile tcl8 -translation lf}} # Input is headers from fetching SPDY draft # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" @@ -486,6 +486,38 @@ test zlib-8.18 {Bug dd260aaf: fconfigure} -setup { catch {close $inSide} catch {close $outSide} } -result {{one two} {one two}} +test zlib-8.19 {zlib transformation, bug f9eafc3886} -constraints zlib -setup { + set file [makeFile {} test.gz] +} -body { + set f [zlib push gzip [open $file w] -header [list comment [string repeat A 500]]] +} -cleanup { + catch {close $f} + removeFile $file +} -returnCodes 1 -result {Comment too large for zip} +test zlib-8.20 {zlib transformation, bug f9eafc3886} -constraints zlib -setup { + set file [makeFile {} test.gz] +} -body { + set f [zlib push gzip [open $file w] -header [list filename [string repeat A 5000]]] +} -cleanup { + catch {close $f} + removeFile $file +} -returnCodes 1 -result {Filename too large for zip} +test zlib-8.21 {zlib transformation, bug f9eafc3886} -constraints zlib -setup { + set file [makeFile {} test.gz] +} -body { + set f [zlib push gzip [open $file w] -header [list comment \u100]] +} -cleanup { + catch {close $f} + removeFile $file +} -returnCodes 1 -result {Comment contains characters > 0xFF} +test zlib-8.22 {zlib transformation, bug f9eafc3886} -constraints zlib -setup { + set file [makeFile {} test.gz] +} -body { + set f [zlib push gzip [open $file w] -header [list filename \u100]] +} -cleanup { + catch {close $f} + removeFile $file +} -returnCodes 1 -result {Filename contains characters > 0xFF} test zlib-9.1 "check fcopy with push" -constraints zlib -setup { set sfile [makeFile {} testsrc.gz] |