Import Tcl 8.6.12

This commit is contained in:
Steve Dower
2021-11-08 17:30:58 +00:00
parent 1aadb2455c
commit 674867e7e6
608 changed files with 78089 additions and 60360 deletions

View File

@@ -228,7 +228,7 @@ test apply-8.3 {args treatment} {
apply [list {x args} $applyBody] 1 2 3
} {{x 1} {args {2 3}}}
test apply-8.4 {default values} {
apply [list {{x 1} {y 2}} $applyBody]
apply [list {{x 1} {y 2}} $applyBody]
} {{x 1} {y 2}}
test apply-8.5 {default values} {
apply [list {{x 1} {y 2}} $applyBody] 3 4

View File

@@ -301,12 +301,12 @@ test assemble-7.1 {add, wrong # args} {
-result {wrong # args*}
}
test assemble-7.2 {add} {
-body {
-body {
assemble {
push 2
push 2
add
}
}
}
-result {4}
}
@@ -349,7 +349,7 @@ test assemble-7.5 {bitwise ops} {
}
test assemble-7.6 {div} {
-body {
assemble {push 999999; push 7; div}
assemble {push 999999; push 7; div}
}
-result 142857
}
@@ -360,7 +360,7 @@ test assemble-7.7 {dup} {
}
}
-result 9
}
}
test assemble-7.8 {eq} {
-body {
list \
@@ -638,7 +638,7 @@ test assemble-7.24 {lsetList} {
test assemble-7.25 {lshift} {
-body {
assemble {push 16; push 4; lshift}
}
}
-result 256
}
test assemble-7.26 {mod} {
@@ -678,7 +678,7 @@ test assemble-7.30 {pop} {
test assemble-7.31 {rshift} {
-body {
assemble {push 257; push 4; rshift}
}
}
-result 16
}
test assemble-7.32 {storeArrayStk} {
@@ -1201,7 +1201,7 @@ test assemble-10.7 {expr - noncompilable} {
# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend,
# nsupvar, variable, upvar)
test assemble-11.1 {exist - wrong # args} {
-body {
assemble {exist}
@@ -1310,7 +1310,7 @@ test assemble-11.10 {variable} {
}
# assemble-12 - ASSEM_LVT1 (incr and incrArray)
test assemble-12.1 {incr - wrong # args} {
-body {
assemble {incr}
@@ -1723,16 +1723,16 @@ test assemble-17.9 {jump - resolve a label multiple times} {
set result {}
assemble {
jump common
label zero
pop
pop
incrImm case 1
pop
push a
append result
pop
jump common
label one
pop
incrImm case 1
@@ -1741,7 +1741,7 @@ test assemble-17.9 {jump - resolve a label multiple times} {
append result
pop
jump common
label common
load case
dup
@@ -1760,7 +1760,7 @@ test assemble-17.9 {jump - resolve a label multiple times} {
push 3
eq
jumpTrue three
label two
pop
incrImm case 1
@@ -1769,7 +1769,7 @@ test assemble-17.9 {jump - resolve a label multiple times} {
append result
pop
jump common
label three
pop
incrImm case 1
@@ -1867,7 +1867,7 @@ test assemble-17.15 {multiple passes of code resizing} {
append body {label b15; push b; concat 2; nop; nop; jump c} \n
append body {label d}
proc x {} [list assemble $body]
}
}
-body {
x
}
@@ -2060,7 +2060,7 @@ test assemble-20.5 {lsetFlat - negative operand count} {
test assemble-20.6 {lsetFlat} {
-body {
assemble {push b; push a; lsetFlat 2}
}
}
-result b
}
test assemble-20.7 {lsetFlat} {
@@ -3046,12 +3046,12 @@ test assemble-40.1 {unbalanced stack} {
[catch {
assemble {
push 3
dup
mult
dup
mult
push 4
dup
mult
pop
dup
mult
pop
expon
}
} result] $result $::errorInfo
@@ -3150,7 +3150,7 @@ test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
load n; # max
dup; # max n
jump start; # max n
label loop; # max n
over 1; # max n max
over 1; # max in max n
@@ -3160,29 +3160,29 @@ test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
reverse 2; # n max
pop; # n
dup; # n n
label skip; # max n
dup; # max n n
push 2; # max n n 2
mod; # max n n%2
jumpTrue odd; # max n
push 2; # max n 2
div; # max n/2 -> max n
jump start; # max n
label odd; # max n
push 3; # max n 3
mult; # max 3*n
push 1; # max 3*n 1
add; # max 3*n+1
label start; # max n
dup; # max n n
push 1; # max n n 1
neq; # max n n>1
jumpTrue loop; # max n
pop; # max
}
}
@@ -3212,7 +3212,7 @@ test assemble-51.3 {memory leak testing} memory {
load n; # max
dup; # max n
jump start; # max n
label loop; # max n
over 1; # max n max
over 1; # max in max n
@@ -3222,29 +3222,29 @@ test assemble-51.3 {memory leak testing} memory {
reverse 2; # n max
pop; # n
dup; # n n
label skip; # max n
dup; # max n n
push 2; # max n n 2
mod; # max n n%2
jumpTrue odd; # max n
push 2; # max n 2
div; # max n/2 -> max n
jump start; # max n
label odd; # max n
push 3; # max n 3
mult; # max 3*n
push 1; # max 3*n 1
add; # max 3*n+1
label start; # max n
dup; # max n n
push 1; # max n n 1
neq; # max n n>1
jumpTrue loop; # max n
pop; # max
}
}} 1
@@ -3277,7 +3277,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel
endCatch
pop
beginCatch @badLabel2
push error
push testing
@@ -3290,7 +3290,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel2
endCatch
pop
beginCatch @badLabel3
push error
push testing
@@ -3303,7 +3303,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel3
endCatch
pop
beginCatch @badLabel4
push error
push testing
@@ -3316,7 +3316,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel4
endCatch
pop
beginCatch @badLabel5
push error
push testing
@@ -3329,7 +3329,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel5
endCatch
pop
beginCatch @badLabel6
push error
push testing

View File

@@ -14,6 +14,9 @@ if {"::tcltest" ni [namespace children]} {
package require tcltest 2.5
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch {package require -exact Tcltest [info patchlevel]}
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]

View File

@@ -135,7 +135,7 @@ test chan-16.4 {chan command: pending subcommand} -body {
chan pending {input output} stdout
} -returnCodes error -result "bad mode \"input output\": must be input or output"
test chan-16.5 {chan command: pending input subcommand} -body {
chan pending input stdout
chan pending input stdout
} -result -1
test chan-16.6 {chan command: pending input subcommand} -body {
chan pending input stdin
@@ -194,7 +194,7 @@ test chan-16.9 {chan command: pending input subcommand} -setup {
set ::chan-16.9-data [list]
set ::chan-16.9-done 0
} -body {
after idle chan-16.9-client
after idle chan-16.9-client
vwait ::chan-16.9-done
set ::chan-16.9-data
} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup {

View File

@@ -760,7 +760,7 @@ test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} {
test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} {
lreverse [list]
} {}
test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup {
test cmdIL-7.8 {lreverse command - shared internalrep [Bug 1675044]} -setup {
teststringobj set 1 {1 2 3}
testobj convert 1 list
testobj duplicate 1 2

View File

@@ -321,7 +321,7 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test
# todo: rewrite this if monotonic clock is provided resp. command "after"
# todo: rewrite this if monotonic clock is provided resp. command "after"
# gets microsecond accuracy (RFE [fdfbd5e10] gets merged):
proc _nrt_sleep {msec} {
set usec [expr {$msec * 1000}]

View File

@@ -728,7 +728,7 @@ test encoding-28.0 {all encodings load} -body {
llength $name
}
return $count
} -result 81
} -result 83
runtests

View File

@@ -419,8 +419,8 @@ test env-8.0 {
# cleanup
rename getenv {}
rename envrestore {}
rename getenv {}
rename envrestore {}
rename envprep {}
rename encodingrestore {}
rename encodingswitch {}

View File

@@ -111,7 +111,7 @@ set path(sh2) [makeFile {
exit
} sh2]
set path(sleep) [makeFile {
after [expr $argv*1000]
after [expr {$argv*1000}]
exit
} sleep]
set path(exit) [makeFile {

View File

@@ -420,13 +420,13 @@ test expr-old-21.3 {parenthesization} {expr +(3-4)} -1
# Embedded commands and variable names.
set a 16
test expr-old-22.1 {embedded variables} {expr {2*$a}} 32
set a 16
test expr-old-22.1 {embedded variables} {expr {2*$a}} 32
test expr-old-22.2 {embedded variables} {
set x -5
set y 10
expr {$x + $y}
} {5}
} {5}
test expr-old-22.3 {embedded variables} {
set x " -5"
set y " +10"
@@ -1120,7 +1120,7 @@ test expr-old-37.25 {Tcl_ExprDouble and NaN} \
{ieeeFloatingPoint testexprdouble} {
list [catch {testexprdouble 0.0/0.0} result] $result
} {1 {domain error: argument not in valid range}}
test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body {
list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
[catch {testexprstring "1+"} msg] $msg

View File

@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testmathfunctions [expr {
([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
([catch {expr {T1()}} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
}]
# Determine if "long int" type is a 32 bit number and if the wide
@@ -138,7 +138,7 @@ proc do_twelve_days {} {
unset xxx
return $result
}
# start of tests
catch {unset a b i x}
@@ -1438,7 +1438,7 @@ test expr-23.74.3 {INST_EXPON: Bug 2798543} {
expr {(-14)**17 == (-14)**65553}
} 0
# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
@@ -5786,7 +5786,7 @@ test expr-32.1 {expr mod basics} {
0 1 0 3 3 \
0 -1 0 -1 -2 \
]
test expr-32.2 {expr div basics} {
set mod_nums [list \
{-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
@@ -6722,6 +6722,12 @@ test expr-38.12 {abs and -0x0 [Bug 2954959]} {
test expr-38.13 {abs and 0.0 [Bug 2954959]} {
::tcl::mathfunc::abs 1e-324
} 1e-324
test expr-38.14 {abs and INT64_MIN special-case} {
::tcl::mathfunc::abs -9223372036854775808
} 9223372036854775808
test expr-38.15 {abs and INT128_MIN special-case} {
::tcl::mathfunc::abs -170141183460469231731687303715884105728
} 170141183460469231731687303715884105728
testConstraint testexprlongobj [llength [info commands testexprlongobj]]
testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]]
@@ -6794,7 +6800,7 @@ test expr-39.16 {Tcl_ExprLongObj handles overflows} \
list [catch {testexprlongobj 4294967296.} result] $result
} \
-result {1 {integer value too large to represent*}}
test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj {
testexprdoubleobj 4.+1.
} {This is a result: 5.0}
@@ -6881,19 +6887,19 @@ test expr-41.13 {exponent overflow} {
} 0.0
test expr-41.14 {exponent overflow} {
expr 100e-2147483651
} 0.0
} 0.0
test expr-41.15 {exponent overflow} {
expr 1.0e-2147483648
} 0.0
} 0.0
test expr-41.16 {exponent overflow} {
expr 1.0e-2147483649
} 0.0
} 0.0
test expr-41.17 {exponent overflow} {
expr 1.23e-2147483646
} 0.0
test expr-41.18 {exponent overflow} {
expr 1.23e-2147483647
} 0.0
} 0.0
test expr-41.19 {numSigDigs == 0} {
expr 0e309
@@ -7269,7 +7275,7 @@ test expr-52.1 {
list [expr {$a eq {}}] [expr {$a < {}}] [expr {$a > {}}] [
string match {*no string representation*} [
::tcl::unsupported::representation $a]]
} {0 0 1 1}
} {0 0 1 1}

View File

@@ -1061,10 +1061,10 @@ test filename-11.45 {Tcl_GlobCmd on root volume} -setup {
set tmpd [pwd]
} -body {
catch {
set res1 [glob -dir [lindex [file volumes] 0] -tails *]
set res1 [glob -dir [lindex [file volumes] end] -tails *]
}
catch {
cd [lindex [file volumes] 0]
cd [lindex [file volumes] end]
set res2 [glob *]
}
list $res1 $res2

View File

@@ -153,7 +153,7 @@ test filesystem-1.10 {link normalisation: double link} -constraints {
[file normalize [file join dir2.link inside.file foo]]
} -cleanup {
file delete dir2.link
} -result ok
} -result ok
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
file link dir2.link dir.link
@@ -168,7 +168,7 @@ test filesystem-1.12 {file new native path} {} {
}
}
# If we reach here we've succeeded. We used to crash above.
expr 1
expr {1}
} {1}
test filesystem-1.13 {file normalisation} {win} {
# This used to be broken
@@ -913,7 +913,7 @@ test filesystem-9.5 {path objects and file tail and object rep} -setup {
}
return $res
} -cleanup {
file delete -force dgp
file delete -force dgp
cd $origdir
} -result {test test}
test filesystem-9.6 {path objects and file tail and object rep} win {

View File

@@ -42,7 +42,7 @@ namespace eval ::tcl::test::fileSystemEncoding {
set globbed [lindex [glob -directory $dir *] 0]
encoding system utf-8
set res [file exists $globbed]
encoding system iso8859-1
encoding system iso8859-1
lappend res [file exists $globbed]
return $res
} -cleanup {

View File

@@ -165,7 +165,7 @@ test foreach-4.1 {noncompiled foreach and shared variable or value list objects
catch {unset x}
foreach {12.0} {a b c} {
set x 12.0
set x [expr $x + 1]
set x [expr {$x + 1}]
}
set x
} 13.0

View File

@@ -460,7 +460,7 @@ test format-13.1 {tcl_precision fuzzy comparison} {
set a 0.0000000000001
set b 0.00000000000001
set c 0.00000000000000001
set d [expr $a + $b + $c]
set d [expr {$a + $b + $c}]
format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
} {0.0000000000 0.000000000000 0.000000000000110 0.00000000000011001}
test format-13.2 {tcl_precision fuzzy comparison} {
@@ -471,7 +471,7 @@ test format-13.2 {tcl_precision fuzzy comparison} {
set a 0.000000000001
set b 0.000000000000005
set c 0.0000000000000008
set d [expr $a + $b + $c]
set d [expr {$a + $b + $c}]
format {%0.10f %0.12f %0.15f %0.17f} $d $d $d $d
} {0.0000000000 0.000000000001 0.000000000001006 0.00000000000100580}
test format-13.3 {tcl_precision fuzzy comparison} {
@@ -480,7 +480,7 @@ test format-13.3 {tcl_precision fuzzy comparison} {
catch {unset c}
set a 0.00000000000099
set b 0.000000000000011
set c [expr $a + $b]
set c [expr {$a + $b}]
format {%0.10f %0.12f %0.15f %0.17f} $c $c $c $c
} {0.0000000000 0.000000000001 0.000000000001001 0.00000000000100100}
test format-13.4 {tcl_precision fuzzy comparison} {
@@ -489,7 +489,7 @@ test format-13.4 {tcl_precision fuzzy comparison} {
catch {unset c}
set a 0.444444444444
set b 0.33333333333333
set c [expr $a + $b]
set c [expr {$a + $b}]
format {%0.10f %0.12f %0.15f %0.16f} $c $c $c $c
} {0.7777777778 0.777777777777 0.777777777777330 0.7777777777773300}
test format-13.5 {tcl_precision fuzzy comparison} {
@@ -498,7 +498,7 @@ test format-13.5 {tcl_precision fuzzy comparison} {
catch {unset c}
set a 0.444444444444
set b 0.99999999999999
set c [expr $a + $b]
set c [expr {$a + $b}]
format {%0.10f %0.12f %0.15f} $c $c $c
} {1.4444444444 1.444444444444 1.444444444443990}
@@ -534,7 +534,7 @@ for {set i 0} {$i < 290} {incr i} {
append b $a
}
for {set i 290} {$i < 400} {incr i} {
test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
test format-16.[expr {$i -289}] {testing MAX_FLOAT_SIZE} {
format {%s} $b
} $b
append b "x"
@@ -605,12 +605,12 @@ test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded}
} -returnCodes error -result "max size for a Tcl value exceeded"
# Note that this test may fail in future versions
test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
test format-20.1 {Bug 2932421: plain %s caused internalrep change of args} -body {
set x [dict create a b c d]
format %s $x
# After this, obj in $x should be a dict
# We are testing to make sure it has not been shimmered to a
# different intrep when that is not necessary.
# different internalrep when that is not necessary.
# Whether or not there is a string rep - we should not care!
tcl::unsupported::representation $x
} -match glob -result {value is a dict *}

View File

@@ -10,7 +10,7 @@
#
# 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::*

View File

@@ -214,7 +214,7 @@ proc httpdRespond { sock } {
}
# Catch errors from premature client closes
catch {
if {$data(proto) == "HEAD"} {
puts $sock "HTTP/1.0 200 OK"

View File

@@ -167,7 +167,7 @@ test httpold-4.1 {httpEvent} {
set token [http_get $url]
upvar #0 $token data
array set meta $data(meta)
expr ($data(totalsize) == $meta(Content-Length))
expr {$data(totalsize) == $meta(Content-Length)}
} 1
test httpold-4.2 {httpEvent} {
@@ -204,7 +204,7 @@ test httpold-4.5 {httpEvent} {
close $out
upvar #0 $token data
removeFile $testfile
expr $data(currentsize) == $data(totalsize)
expr {$data(currentsize) == $data(totalsize)}
} 1
test httpold-4.6 {httpEvent} {

View File

@@ -657,7 +657,7 @@ test info-19.6 {info vars: Bug 1072654} -setup {
set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isqrt log log10 max min pow rand round sin sinh sqrt srand tan tanh wide}
# Check whether the extra testing functions are defined...
if {!([catch {expr T1()} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} {
if {!([catch {expr {T1()}} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} {
set functions "T1 T2 T3 $functions" ;# A lazy way of prepending!
}
test info-20.1 {info functions option} {info functions sin} sin

View File

@@ -41,7 +41,7 @@ test init-1.2 {auto_qualify - absolute cmd - global} {
} global
test init-1.3 {auto_qualify - no colons cmd - global} {
auto_qualify nocolons ::
} nocolons
} nocolons
test init-1.4 {auto_qualify - no colons cmd - namespace} {
auto_qualify nocolons ::sub
} {::sub::nocolons nocolons}
@@ -106,11 +106,11 @@ test init-2.5 {load safe:::setLogCmd - stage 2} {
auto_reset
catch {rename ::safe::setLogCmd {}}
test init-2.6 {load setLogCmd from safe:: - stage 1} {
namespace eval safe setLogCmd
namespace eval safe setLogCmd
rename ::safe::setLogCmd {} ;# should not fail
} {}
test init-2.7 {oad setLogCmd from safe:: - stage 2} {
namespace eval safe setLogCmd
namespace eval safe setLogCmd
rename ::safe::setLogCmd {} ;# should not fail
} {}
test init-2.8 {load tcl::HistAdd} -setup {
@@ -145,12 +145,12 @@ foreach arg [subst -nocommands -novariables {
and is long enough to be truncated and
" <- includes a false lead in the prune point search
and must be longer still to force truncation}
{contrived example: rare circumstance
{contrived example: rare circumstance
where the point at which to prune the
error stack cannot be uniquely determined.
foo bar foo
"}
{contrived example: rare circumstance
{contrived example: rare circumstance
where the point at which to prune the
error stack cannot be uniquely determined.
foo bar

View File

@@ -21,7 +21,7 @@ namespace path ::tcltest
# Options:
# -addmem - set additional memory limit (in bytes) as difference (extra memory needed to run a test)
# -maxmem - set absolute maximum address space limit (in bytes)
#
#
proc testWithLimit args {
set body [lindex $args end]
array set in [lrange $args 0 end-1]
@@ -45,7 +45,7 @@ proc testWithLimit args {
incr in(-addmem) 20000000
# + size of locale-archive (may be up to 100MB):
incr in(-addmem) [expr {
[file exists /usr/lib/locale/locale-archive] ?
[file exists /usr/lib/locale/locale-archive] ?
[file size /usr/lib/locale/locale-archive] : 0
}]
}

View File

@@ -1943,11 +1943,11 @@ test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel}
eof stdin
interp create x
set l ""
lappend l [expr [testchannel refcount stdin] - $l1]
lappend l [expr {[testchannel refcount stdin] - $l1}]
x eval {eof stdin}
lappend l [expr [testchannel refcount stdin] - $l1]
lappend l [expr {[testchannel refcount stdin] - $l1}]
interp delete x
lappend l [expr [testchannel refcount stdin] - $l1]
lappend l [expr {[testchannel refcount stdin] - $l1}]
set l
} {0 1 0}
test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
@@ -1955,11 +1955,11 @@ test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel}
eof stdin
interp create x
set l ""
lappend l [expr [testchannel refcount stdout] - $l1]
lappend l [expr {[testchannel refcount stdout] - $l1}]
x eval {eof stdout}
lappend l [expr [testchannel refcount stdout] - $l1]
lappend l [expr {[testchannel refcount stdout] - $l1}]
interp delete x
lappend l [expr [testchannel refcount stdout] - $l1]
lappend l [expr {[testchannel refcount stdout] - $l1}]
set l
} {0 1 0}
test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
@@ -1967,11 +1967,11 @@ test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel}
eof stdin
interp create x
set l ""
lappend l [expr [testchannel refcount stderr] - $l1]
lappend l [expr {[testchannel refcount stderr] - $l1}]
x eval {eof stderr}
lappend l [expr [testchannel refcount stderr] - $l1]
lappend l [expr {[testchannel refcount stderr] - $l1}]
interp delete x
lappend l [expr [testchannel refcount stderr] - $l1]
lappend l [expr {[testchannel refcount stderr] - $l1}]
set l
} {0 1 0}
@@ -2161,7 +2161,7 @@ test io-26.1 {Tcl_GetChannelInstanceData} stdio {
# Don't care what pid is (but must be a number), just want to exercise it.
set f [open "|[list [interpreter] << exit]"]
expr [pid $f]
expr {[pid $f]}
close $f
} {}
@@ -3162,7 +3162,7 @@ test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
set c [read $f]
close $f
string length $c
} [expr 700*15+1]
} [expr {700*15+1}]
test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
file delete $path(test1)
set f [open $path(test1) w]
@@ -3178,7 +3178,7 @@ test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
set c [read $f]
close $f
string length $c
} [expr 700*15+1]
} [expr {700*15+1}]
test io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
file delete $path(test1)
set f [open $path(test1) w]
@@ -3996,7 +3996,7 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
}
close $f
string length $c
} [expr 700*15+1]
} [expr {700*15+1}]
test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
file delete $path(test1)
set f [open $path(test1) w]
@@ -4015,7 +4015,7 @@ test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
}
close $f
string length $c
} [expr 700*15+1]
} [expr {700*15+1}]
# Test Tcl_Read and buffering.
@@ -5641,7 +5641,7 @@ test io-40.2 {POSIX open access modes: CREAT} {unix} {
file delete $path(test3)
set f [open $path(test3) {WRONLY CREAT} 0o600]
file stat $path(test3) stats
set x [format "0o%o" [expr $stats(mode)&0o777]]
set x [format "0o%o" [expr {$stats(mode)&0o777}]]
puts $f "line 1"
close $f
set f [open $path(test3) r]
@@ -5655,7 +5655,7 @@ test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
set f [open $path(test3) {WRONLY CREAT}]
close $f
file stat $path(test3) stats
format "0o%03o" [expr $stats(mode)&0o777]
format "0o%03o" [expr {$stats(mode)&0o777}]
} [format "0o%03o" [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
file delete $path(test3)
@@ -7093,7 +7093,7 @@ test io-52.6 {TclCopyChannel} {fcopy} {
set f2 [open $path(test1) w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
set s0 [fcopy $f1 $f2 -size [expr [file size $thisScript] + 5]]
set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
@@ -7589,7 +7589,7 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} {
catch {close $in}
close $out
# -1=error 0=script error N=number of bytes
expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1}
} {3450}
test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
# copy progress callback. errors out intentionally
@@ -8624,7 +8624,7 @@ test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
} {1}
test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup {
# Invalidate intrep of 'channel' Tcl_Obj when transiting between interpreters.
# Invalidate internalrep of 'channel' Tcl_Obj when transiting between interpreters.
set f [open [info script] r]
} -body {
interp create foo

View File

@@ -5,7 +5,7 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
# Copyright (c) 2000 Ajuba Solutions.
# Copyright (c) 2000 Andreas Kupries.
# All rights reserved.

View File

@@ -441,7 +441,7 @@ test lindex-16.7 {data reuse} {
test lindex-17.0 {Bug 1718580} {*}{
-body {
lindex {} end foo
}
}
-match glob
-result {bad index "foo"*}
-returnCodes 1
@@ -450,7 +450,7 @@ test lindex-17.0 {Bug 1718580} {*}{
test lindex-17.1 {Bug 1718580} {*}{
-body {
lindex a end foo
}
}
-match glob
-result {bad index "foo"*}
-returnCodes 1

View File

@@ -220,10 +220,10 @@ test lmap-4.14 {lmap errors} -returnCodes error -body {
} -result {list element in braces followed by "3" instead of space}
unset -nocomplain a
test lmap-4.15 {lmap errors} {
apply {{} {
apply {{} {
set a(0) 44
list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
}}
list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
}}
} {1 {can't set "a": variable is array} {can't set "a": variable is array
while executing
"lmap a {1 2 3} {}"}}
@@ -357,7 +357,7 @@ test lmap-7.2 {noncompiled lmap and shared variable or value list objects that a
} -body {
lmap {12.0} {a b c} {
set x 12.0
set x [expr $x + 1]
set x [expr {$x + 1}]
}
} -result {13.0 13.0 13.0}
# Test for incorrect "double evaluation" semantics

View File

@@ -5,7 +5,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -78,13 +78,13 @@ test load-2.1 {basic loading, with guess for package name} \
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
[list $dll $loaded] {
load -lazy [file join $testDir pkgb$ext] pKgB child
load -lazy [file join $testDir pkgb$ext] Pkgb child
list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
[catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
list [catch {load [file join $testDir pkgc$ext] Foo} msg] $msg $errorCode
} -match glob \
-result [list 1 {cannot find symbol "Foo_Init"*} \
{TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
@@ -94,7 +94,7 @@ test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
test load-3.1 {error in _Init procedure, same interpreter} \
[list $dll $loaded] {
list [catch {load [file join $testDir pkge$ext] pkge} msg] \
list [catch {load [file join $testDir pkge$ext] Pkge} msg] \
$msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
while executing
@@ -102,14 +102,14 @@ test load-3.1 {error in _Init procedure, same interpreter} \
invoked from within
"if 44 {open non_existent}"
invoked from within
"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
"load [file join $testDir pkge$ext] Pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, child interpreter} \
[list $dll $loaded] {
catch {interp delete x}
interp create x
set ::errorCode foo
set ::errorInfo bar
set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
set result [list [catch {load [file join $testDir pkge$ext] Pkge x} msg] \
$msg $::errorInfo $::errorCode]
interp delete x
set result
@@ -119,23 +119,23 @@ test load-3.2 {error in _Init procedure, child interpreter} \
invoked from within
"if 44 {open non_existent}"
invoked from within
"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}
"load [file join $testDir pkge$ext] Pkge x"} {POSIX ENOENT {no such file or directory}}}
test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
list [catch {load [file join $testDir pkga$ext] Pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
catch {load [file join $testDir pkga$ext] pkga}
catch {load [file join $testDir pkga$ext] Pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
load [file join $testDir pkga$ext] pkgb
load [file join $testDir pkga$ext] Pkgb
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""
test load-5.1 {file name not specified and no static package: pick default} -setup {
catch {interp delete x}
interp create x
} -constraints [list $dll $loaded] -body {
load -global [file join $testDir pkga$ext] pkga
load {} pkga x
load -global [file join $testDir pkga$ext] Pkga
load {} Pkga x
info loaded x
} -cleanup {
interp delete x
@@ -171,9 +171,9 @@ test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
load {} More
set x
} {not loaded}
catch {load [file join $testDir pkga$ext] pkga}
catch {load [file join $testDir pkgb$ext] pkgb}
catch {load [file join $testDir pkge$ext] pkge}
catch {load [file join $testDir pkga$ext] Pkga}
catch {load [file join $testDir pkgb$ext] Pkgb}
catch {load [file join $testDir pkge$ext] Pkge}
set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
teststaticpkg Test 1 0
@@ -209,7 +209,7 @@ test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $lo
lsort -index 1 [info loaded child]
} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
load [file join $testDir pkgb$ext] pkgb
load [file join $testDir pkgb$ext] Pkgb
list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child
@@ -234,7 +234,7 @@ test load-10.1 {load from vfs} -setup {
cd $testDir
testsimplefilesystem 1
} -constraints [list $dll $loaded testsimplefilesystem] -body {
list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg
list [catch {load simplefs:/pkgd$ext Pkgd} msg] $msg
} -result {0 {}} -cleanup {
testsimplefilesystem 0
cd $dir

View File

@@ -69,7 +69,7 @@ test lrange-1.15 {range of list elements} {
} {"a b \{\ "}
# emacs highlighting bug workaround --> "
test lrange-1.16 {list element quoting} {
lrange {[append a .b]} 0 end
lrange {[append a .b]} 0 end
} {{[append} a .b\]}
test lrange-2.1 {error conditions} {

View File

@@ -40,7 +40,7 @@ test lrepeat-1.4 {error cases} {
lrepeat -3 1
}
-returnCodes 1
-result {bad count "-3": must be integer >= 0}
-result {bad count "-3": must be integer >= 0}
}
test lrepeat-1.5 {Accept zero repetitions (TIP 323)} {
-body {
@@ -53,7 +53,7 @@ test lrepeat-1.6 {error cases} {
lrepeat 3.5 1
}
-returnCodes 1
-result {expected integer but got "3.5"}
-result {expected integer but got "3.5"}
}
test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
-body {

View File

@@ -412,7 +412,7 @@ test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testeva
} "{ { 1 2 } { 3 4 } } { 3 4 }"
testConstraint testobj [llength [info commands testobj]]
test lset-15.1 {lset: shared intrep [Bug 1677512]} -setup {
test lset-15.1 {lset: shared internalrep [Bug 1677512]} -setup {
teststringobj set 1 {{1 2} 3}
testobj convert 1 list
testobj duplicate 1 2

View File

@@ -25,7 +25,7 @@ testConstraint testhashsystemhash [llength [info commands testhashsystemhash]]
test misc-1.1 {error in variable ref. in command in array reference} {
proc tstProc {} {
global a
set tst $a([winfo name $zz])
# this is a bogus comment
# this is a bogus comment
@@ -42,7 +42,7 @@ test misc-1.1 {error in variable ref. in command in array reference} {
test misc-1.2 {error in variable ref. in command in array reference} {
proc tstProc {} "
global a
set tst \$a(\[winfo name \$\{zz)
# this is a bogus comment
# this is a bogus comment

View File

@@ -1846,6 +1846,24 @@ test namespace-42.10 {
unset -nocomplain lst
} -returnCodes error -match glob -result {invalid command name *three*}
test namespace-42.11 {
ensembles: prefix matching segmentation fault
issue ccc448a6bfd59cbd
} -body {
namespace eval n1 {
namespace ensemble create
namespace export *
proc p1 args {error success}
}
# segmentation fault only occurs in the non-byte-compiled path, so avoid
# byte compilation
set cmd {namespace eva n1 {[namespace parent]::n1 p1}}
{*}$cmd
} -returnCodes error -result success
test namespace-43.1 {ensembles: dict-driven} {
namespace eval ns {
namespace export x*
@@ -3340,6 +3358,38 @@ test namespace-56.5 {Bug 8b9854c3d8} -setup {
} -result 1
test namespace-56.6 {
Namespace deletion traces on both the original routine and the imported
routine should run without any memory error under a debug build.
} -body {
variable res 0
proc ondelete {old new op} {
$old
}
namespace eval ns1 {} {
namespace export *
proc p1 {} {
namespace upvar [namespace parent] res res
incr res
}
trace add command p1 delete ondelete
}
namespace eval ns2 {} {
namespace import ::ns1::p1
trace add command p1 delete ondelete
}
namespace delete ns1
namespace delete ns2
return $res
} -cleanup {
unset res
rename ondelete {}
} -result 2
test namespace-57.0 {
an imported alias should be usable in the deletion trace for the alias

View File

@@ -29,9 +29,9 @@ if {[testConstraint testnrelevels]} {
namespace path ::tcl::mathop
#
# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
# cmdFrame level, callFrame level, tosPtr and callback depth
# cmdFrame level, callFrame level, tosPtr and callback depth
#
variable last [testnrelevels]
variable last [testnrelevels]
proc depthDiff {} {
variable last
set depth [testnrelevels]
@@ -329,7 +329,7 @@ test nre-8.1 {nre and {*}} -body {
} -cleanup {
rename inner {}
rename outer {}
} -result {1 1 1}
} -result {1 1 1}
test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
# force an expansion that grows the evaluation stack, check that nre
# adapts the bcFramePtr. This causes an NRE assertion to fail if it is not

View File

@@ -26,7 +26,7 @@ testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
set r 1
foreach {t} {
{array search}
{array search}
bytearray
bytecode
cmdName
@@ -82,7 +82,7 @@ test obj-6.1 {Tcl_DuplicateObj, object has internal rep} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 47]
lappend result [testobj duplicate 1 2]
lappend result [testobj duplicate 1 2]
lappend result [testintobj get 2]
lappend result [testobj refcount 1]
lappend result [testobj refcount 2]
@@ -91,7 +91,7 @@ test obj-6.2 {Tcl_DuplicateObj, "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
lappend result [testobj duplicate 1 2]
lappend result [testobj duplicate 1 2]
lappend result [testintobj get 2]
lappend result [testobj refcount 1]
lappend result [testobj refcount 2]

View File

@@ -613,13 +613,13 @@ test package-3.54 {Tcl_PkgRequire procedure, coroutine support} -setup {
} -body {
coroutine coro1 apply {{} {
package ifneeded t 2.1 {
yield
yield
package provide t 2.1
}
package require t 2.1
}}
list [catch {coro1} msg] $msg
} -match glob -result {0 2.1}
} -match glob -result {0 2.1}
test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {

View File

@@ -278,7 +278,7 @@ test parse-6.9 {ParseTokens procedure, error in command substitution} {
} {0}
test parse-6.10 {ParseTokens procedure, incomplete sub-command} {
info complete {puts [
expr 1+1
expr {1+1}
#this is a comment ]}
} {0}
test parse-6.11 {ParseTokens procedure, memory allocation for big nested command} testparser {
@@ -485,7 +485,7 @@ test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
} {8}
test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
unset -nocomplain a
list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
list [catch {testevalex {concat xxx[expr {$a}]}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
set a hello
@@ -518,7 +518,7 @@ test parse-10.11 {Tcl_EvalTokens, object values} testevalex {
testevalex {concat $a$a$a}
} {123123123}
test parse-10.12 {Tcl_EvalTokens, object values} testevalex {
testevalex {concat [expr 2][expr 4][expr 6]}
testevalex {concat [expr {2}][expr {4}][expr {6}]}
} {246}
test parse-10.13 {Tcl_EvalTokens, string values} testevalex {
testevalex {concat {a" b"}}
@@ -984,26 +984,26 @@ test parse-18.14 {Tcl_SubstObj, exception handling} {
subst {abc,[break],def}
} {abc,}
test parse-18.15 {Tcl_SubstObj, exception handling} {
subst {abc,[continue; expr 1+2],def}
subst {abc,[continue; expr {1+2}],def}
} {abc,,def}
test parse-18.16 {Tcl_SubstObj, exception handling} {
subst {abc,[return foo; expr 1+2],def}
subst {abc,[return foo; expr {1+2}],def}
} {abc,foo,def}
test parse-18.17 {Tcl_SubstObj, exception handling} {
subst {abc,[return -code 10 foo; expr 1+2],def}
subst {abc,[return -code 10 foo; expr {1+2}],def}
} {abc,foo,def}
test parse-18.18 {Tcl_SubstObj, exception handling} {
subst {abc,[break; set {} {}{}],def}
} {abc,}
test parse-18.19 {Tcl_SubstObj, exception handling} {
list [catch {subst {abc,[continue; expr 1+2; set {} {}{}],def}} msg] $msg
list [catch {subst {abc,[continue; expr {1+2}; set {} {}{}],def}} msg] $msg
} [list 1 "extra characters after close-brace"]
test parse-18.20 {Tcl_SubstObj, exception handling} {
list [catch {subst {abc,[return foo; expr 1+2; set {} {}{}],def}} msg] $msg
list [catch {subst {abc,[return foo; expr {1+2}; set {} {}{}],def}} msg] $msg
} [list 1 "extra characters after close-brace"]
test parse-18.21 {Tcl_SubstObj, exception handling} {
list [catch {
subst {abc,[return -code 10 foo; expr 1+2; set {} {}{}],def}
subst {abc,[return -code 10 foo; expr {1+2}; set {} {}{}],def}
} msg] $msg
} [list 1 "extra characters after close-brace"]

View File

@@ -770,11 +770,11 @@ test parseExpr-21.8 {error messages} -body {
expr {0o8x}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.9 {error messages} -body {
expr {"}
expr {"}
} -returnCodes error -result {missing "
in expression """}
test parseExpr-21.10 {error messages} -body {
expr \{
expr \{
} -returnCodes error -result "missing close-brace
in expression \"\{\""
test parseExpr-21.11 {error messages} -body {

View File

@@ -455,14 +455,14 @@ test parseOld-12.4 {comments} {
test parseOld-13.1 {comments at the end of a bracketed script} {
set x "[
expr 1+1
expr {1+1}
# skip this!
]"
} {2}
test parseOld-15.1 {TclScriptEnd procedure} {
info complete {puts [
expr 1+1
expr {1+1}
#this is a comment ]}
} {0}
test parseOld-15.2 {TclScriptEnd procedure} {

View File

@@ -5,7 +5,7 @@
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
# All rights reserved.
if {"::tcltest" ni [namespace children]} {
@@ -559,8 +559,8 @@ testConstraint $dll [file exists $x]
if {[testConstraint $dll]} {
makeFile {
# This package provides Pkga, which is also provided by a DLL.
package provide Pkga 1.0
# This package provides pkga, which is also provided by a DLL.
package provide pkga 1.0
proc pkga_neq { x } {
return [expr {! [pkgq_eq $x]}]
}
@@ -576,7 +576,7 @@ test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
exec [interpreter] << $cmd
pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
} "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
# Do all [load]ing of shared libraries in another process, so we can
# delete the file and not get stuck because we're holding a reference to

View File

@@ -54,12 +54,12 @@ test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
test platform-3.1 {CPU ID on Windows/UNIX} \
-constraints testCPUID \
-body {
-body {
set cpudata [testcpuid 0]
binary format iii \
[lindex $cpudata 1] \
[lindex $cpudata 3] \
[lindex $cpudata 2]
[lindex $cpudata 2]
} \
-match regexp \
-result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}

View File

@@ -324,6 +324,15 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} procbodytest {
procbodytest::check
} 1
test proc-4.10 {
TclCreateProc, issue a8579d906a28, argument with no name
} -body {
catch {
proc p1 [list [list [expr {1 + 2}] default]] {}
}
} -cleanup {
catch {rename p1 {}}
} -result 0
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t

View File

@@ -1220,6 +1220,10 @@ test reg-33.29 {} {
test reg-33.30 {Bug 1080042} {
regexp {(\Y)+} foo
} 1
test reg-33.31 {Bug 7c64aa5e1a} {
regexp -inline {(?b).\{1,10\}} {abcdef}
} abcdef
# cleanup
::tcltest::cleanupTests

View File

@@ -491,7 +491,7 @@ test regexp-11.12 {regsub without final variable name returns value} {
} {a,bcd,c,ea,bcfd,cf,e}
# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg. This is probably bigger than most users want...
# Meg. This is probably bigger than most users want...
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
@@ -753,10 +753,10 @@ test regexp-19.2 {regsub null replacement} {
test regexp-20.1 {regsub shared object shimmering} {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d] [string bytelength $d]
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexp-20.2 {regsub shared object shimmering with -about} {

View File

@@ -22,7 +22,7 @@ if {"::tcltest" ni [namespace children]} {
proc evalInProc { script } {
proc testProc {} $script
set status [catch {
testProc
testProc
} result]
rename testProc {}
return $result
@@ -607,7 +607,7 @@ test regexpComp-11.8 {regsub errors, -start bad int check} {
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg. This is probably bigger than most users want...
# Meg. This is probably bigger than most users want...
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
@@ -794,10 +794,10 @@ test regexpComp-19.1 {regsub null replacement} {
test regexpComp-20.1 {regsub shared object shimmering} {
evalInProc {
# Bug #461322
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
set a abcdefghijklmnopqurstuvwxyz
set b $a
set c abcdefghijklmnopqurstuvwxyz0123456789
regsub $a $c $b d
list $d [string length $d] [string bytelength $d]
}
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]

View File

@@ -43,7 +43,7 @@ test split-1.8 {basic split commands} {
foreach f [split {]\n} {}] {
append x $f
}
return $x
return $x
}
foo
} {]\n}

View File

@@ -33,7 +33,7 @@ test stack-2.1 {maxNestingDepth reached on infinite recursion} -body {
puts $msg
}
} -result {too many nested evaluations (infinite loop?)}
# Make sure that there is enough stack to run regexp even if we're
# close to the recursion limit. [Bug 947070] [Patch 746378]
test stack-3.1 {enough room for regexp near recursion limit} -body {

View File

@@ -414,7 +414,7 @@ test string-6.27 {string is double, true} {
string is double 1
} 1
test string-6.28 {string is double, true} {
string is double [expr double(1)]
string is double [expr {double(1)}]
} 1
test string-6.29 {string is double, true} {
string is double 1.0
@@ -489,7 +489,7 @@ test string-6.48 {string is integer, true} {
string is integer +1234567890
} 1
test string-6.49 {string is integer, true on type} {
string is integer [expr int(50.0)]
string is integer [expr {int(50.0)}]
} 1
test string-6.50 {string is integer, true} {
string is integer [list -10]
@@ -510,7 +510,7 @@ test string-6.55 {string is integer, false on overflow} {
list [string is integer -fail var +[largest_int]0] $var
} {0 -1}
test string-6.56 {string is integer, false} {
list [string is integer -fail var [expr double(1)]] $var
list [string is integer -fail var [expr {double(1)}]] $var
} {0 1}
test string-6.57 {string is integer, false} {
list [string is integer -fail var " "] $var
@@ -659,7 +659,7 @@ test string-6.95 {string is wideinteger, true} {
string is wideinteger +1234567890
} 1
test string-6.96 {string is wideinteger, true on type} {
string is wideinteger [expr wide(50.0)]
string is wideinteger [expr {wide(50.0)}]
} 1
test string-6.97 {string is wideinteger, true} {
string is wideinteger [list -10]
@@ -680,7 +680,7 @@ test string-6.102 {string is wideinteger, false on overflow} {
list [string is wideinteger -fail var +[largest_int]0] $var
} {0 -1}
test string-6.103 {string is wideinteger, false} {
list [string is wideinteger -fail var [expr double(1)]] $var
list [string is wideinteger -fail var [expr {double(1)}]] $var
} {0 1}
test string-6.104 {string is wideinteger, false} {
list [string is wideinteger -fail var " "] $var
@@ -715,7 +715,7 @@ test string-6.110 {string is entier, true} {
string is entier +1234567890
} 1
test string-6.111 {string is entier, true on type} {
string is entier [expr wide(50.0)]
string is entier [expr {wide(50.0)}]
} 1
test string-6.112 {string is entier, true} {
string is entier [list -10]
@@ -736,7 +736,7 @@ test string-6.117 {string is entier, false} {
list [string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc] $var
} {0 84}
test string-6.118 {string is entier, false} {
list [string is entier -fail var [expr double(1)]] $var
list [string is entier -fail var [expr {double(1)}]] $var
} {0 1}
test string-6.119 {string is entier, false} {
list [string is entier -fail var " "] $var
@@ -1645,6 +1645,33 @@ test string-21.13 {string wordend, unicode} {
test string-21.14 {string wordend, unicode} {
string wordend "\uC700\uC700 abc" 8
} 6
test string-21.17 {string trim, unicode} {
string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02
} "Hello world!"
test string-21.18 {string trimleft, unicode} {
string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02
} "Hello world!\uD83D\uDE02"
test string-21.19 {string trimright, unicode} {
string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD83D\uDE02
} "\uD83D\uDE02Hello world!"
test string-21.20 {string trim, unicode} {
string trim "\uF602Hello world!\uF602" \uD83D\uDE02
} "\uF602Hello world!\uF602"
test string-21.21 {string trimleft, unicode} {
string trimleft "\uF602Hello world!\uF602" \uD83D\uDE02
} "\uF602Hello world!\uF602"
test string-21.22 {string trimright, unicode} {
string trimright "\uF602Hello world!\uF602" \uD83D\uDE02
} "\uF602Hello world!\uF602"
test string-21.23 {string trim, unicode} {
string trim "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02
} "\uD83D\uDE02Hello world!\uD83D\uDE02"
test string-21.24 {string trimleft, unicode} {
string trimleft "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02
} "\uD83D\uDE02Hello world!\uD83D\uDE02"
test string-21.25 {string trimright, unicode} {
string trimright "\uD83D\uDE02Hello world!\uD83D\uDE02" \uD93D\uDE02
} "\uD83D\uDE02Hello world!\uD83D\uDE02"
test string-22.1 {string wordstart} {
list [catch {string word a} msg] $msg
@@ -1801,6 +1828,24 @@ test string-24.15 {string reverse command - pure bytearray} {
binary scan [tcl::string::reverse [binary format H* 010203]] H* x
set x
} 030201
test string-24.16 {string reverse command - surrogates} {
string reverse \u0444bulb\uD83D\uDE02
} \uD83D\uDE02blub\u0444
test string-24.17 {string reverse command - surrogates} {
string reverse \uD83D\uDE02hello\uD83D\uDE02
} \uD83D\uDE02olleh\uD83D\uDE02
test string-24.18 {string reverse command - surrogates} {
set s \u0444bulb\uD83D\uDE02
# shim shimmery ...
string index $s 0
string reverse $s
} \uD83D\uDE02blub\u0444
test string-24.19 {string reverse command - surrogates} {
set s \uD83D\uDE02hello\uD83D\uDE02
# shim shimmery ...
string index $s 0
string reverse $s
} \uD83D\uDE02olleh\uD83D\uDE02
test string-25.1 {string is list} {
string is list {a b c}

View File

@@ -28,9 +28,9 @@ if {[testConstraint testnrelevels]} {
namespace eval testnre {
#
# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
# cmdFrame level, callFrame level, tosPtr and callback depth
# cmdFrame level, callFrame level, tosPtr and callback depth
#
variable last [testnrelevels]
variable last [testnrelevels]
proc depthDiff {} {
variable last
set depth [testnrelevels]
@@ -148,7 +148,7 @@ test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup
} -result {0 0 0 0 0 0}
test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -setup {
#
#
# This test is related to [bug d87cb182053fd79b3]: the fix to that bug was
# to remove a call to TclSkipTailcall, which caused a violation of the
# constant-space property of tailcall in that particular
@@ -245,7 +245,7 @@ test tailcall-1 {tailcall} -body {
}
variable x *::
proc xset args {error ::xset}
list [::b::moo] | $x $a::x $b::x | $::b::y
list [::b::moo] | $x $a::x $b::x | $::b::y
} -cleanup {
unset x
rename xset {}
@@ -619,7 +619,7 @@ test tailcall-12.3a3 {[Bug 2695587]} -body {
set x
} -cleanup {
unset x
} -result {0 1}
} -result {0 1}
test tailcall-12.3b0 {[Bug 2695587]} -body {
apply {{} {
@@ -654,7 +654,7 @@ test tailcall-12.3b3 {[Bug 2695587]} -body {
set x
} -cleanup {
unset x
} -result {0 1}
} -result {0 1}
# MORE VARIANTS MISSING: bc'ed caught script vs (bc'ed, not-bc'ed)
# catch. Actually superfluous now, as tailcall just returns TCL_RETURN so that

View File

@@ -37,7 +37,7 @@ test unixforkevent-1.1 {fork and test writeable event} \
viewFile result.txt $myFolder
} \
-result {writable} \
-cleanup {
-cleanup {
catch { removeFolder $myFolder }
}

View File

@@ -34,7 +34,7 @@ test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -
vwait x
close $f
list [catch {vwait x} msg] $msg
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
catch { close $f }
catch { removeFile foo }
}
@@ -90,7 +90,7 @@ test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
set x
} \
-result {ok} \
-cleanup {
-cleanup {
catch { close $f1 }
catch { close $f2 }
catch { removeFile foo }

View File

@@ -5,8 +5,8 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2003-2004 by Georgios Petasis
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2003-2004 Georgios Petasis
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -135,14 +135,14 @@ child eval {
test unload-3.1 {basic loading of non-unloadable package in a safe interpreter, with package name conversion} \
[list $dll $loaded] {
catch {rename pkgb_sub {}}
load [file join $testDir pkgb$ext] pKgB child
load [file join $testDir pkgb$ext] Pkgb child
list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
[catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test unload-3.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
[list $dll $loaded] {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] pKgUA child] \
[load [file join $testDir pkgua$ext] Pkgua child] \
[child eval pkgua_eq abc def] \
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
@@ -154,14 +154,14 @@ test unload-3.3 {unloading of a package that has never been loaded from a safe i
} -result {file "*" has never been loaded in this interpreter}
test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup {
if {[lsearch -index 1 [info loaded child] Pkgb] < 0} {
load [file join $testDir pkgb$ext] pKgB child
load [file join $testDir pkgb$ext] Pkgb child
}
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
unload [file join $testDir pkgb$ext] {} child
} -result {file "*" cannot be unloaded under a safe interpreter}
test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup {
if {[lsearch -index 1 [info loaded child] Pkgua] < 0} {
load [file join $testDir pkgua$ext] pkgua child
load [file join $testDir pkgua$ext] Pkgua child
}
} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
@@ -189,7 +189,7 @@ test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, w
}
} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] pKgUa child] \
[unload [file join $testDir pkgua$ext] Pkgua child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{.. . .} {} {} {.. .. ..}}
@@ -224,7 +224,7 @@ test unload-4.2 {basic loading of unloadable package in a safe interpreter, with
incr load(C)
} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] pKgUA child] \
[load [file join $testDir pkgua$ext] Pkgua child] \
[child eval pkgua_eq abc def] \
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
@@ -234,7 +234,7 @@ test unload-4.3 {basic loading of unloadable package in a second trusted interpr
incr load(T)
} -constraints [list $dll $loaded] -body {
list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] pkguA child-trusted] \
[load [file join $testDir pkgua$ext] Pkgua child-trusted] \
[child-trusted eval pkgua_eq abc def] \
[lsort [child-trusted eval info commands pkgua_*]] \
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
@@ -291,7 +291,7 @@ test unload-5.1 {unload a module loaded from vfs} \
set dir [pwd]
cd $testDir
testsimplefilesystem 1
load simplefs:/pkgua$ext pkgua
load simplefs:/pkgua$ext Pkgua
} \
-body {
list [catch {unload simplefs:/pkgua$ext} msg] $msg

View File

@@ -492,7 +492,7 @@ test upvar-NS-1.4 {nsupvar links to correct variable} -body {
} -returnCodes error -cleanup {
namespace delete test_ns_1
} -result {namespace "test_ns_0" not found in "::test_ns_1"}
test upvar-NS-1.5 {nsupvar links to correct variable} -body {
namespace eval test_ns_1 {
namespace eval test_ns_0 {}

View File

@@ -3,7 +3,7 @@
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -57,10 +57,10 @@ test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
expr {[format %c -1] eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf Uesc testbytestring} {
test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf testbytestring} {
expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 1
test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {ucs2 Uesc testbytestring} {
test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {Uesc ucs2 testbytestring} {
expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 0
test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
@@ -78,9 +78,12 @@ test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring
test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4bytes testbytestring} {
expr {"\uD842\uDC42" eq [testbytestring \xF0\xA0\xA1\x82]}
} 1
test utf-1.13 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc ucs2} {
test utf-1.13.0 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc ucs2} {
expr {"\UD842" eq "\uD842"}
} 1
test utf-1.13.1 {Tcl_UniCharToUtf: Invalid surrogate} {fullutf testbytestring} {
expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
string length "abc"
@@ -103,16 +106,22 @@ test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestrin
test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
string length [testbytestring \xE4\xB9\x8E]
} 1
test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} {
test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} {
string length [testbytestring \xF0\x90\x80\x80]
} 2
test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs4} {
string length [testbytestring \xF0\x90\x80\x80]
test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 {
string length \U010000
} 2
test utf-2.8.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} ucs4 {
string length \U010000
} 1
test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} {
test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} {
string length [testbytestring \xF4\x8F\xBF\xBF]
} 2
test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} {
test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 {
string length \U10FFFF
} 2
test utf-2.9.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} ucs4 {
string length \U10FFFF
} 1
test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring {
@@ -195,7 +204,7 @@ test utf-6.3 {Tcl_UtfNext} testutfnext {
testutfnext AA
} 1
test utf-6.4 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext A[testbytestring \xA0]
testutfnext [testbytestring A\xA0]
} 1
test utf-6.5 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext A[testbytestring \xD0]
@@ -215,9 +224,12 @@ test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring} {
test utf-6.10 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xA0]G
} 1
test utf-6.11 {Tcl_UtfNext} {testutfnext testbytestring} {
test utf-6.11.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xA0\xA0\x00]
} 1
test utf-6.11.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xA0\xA0\x00]
} 2
test utf-6.12 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext [testbytestring \xA0\xD0]
} 1
@@ -378,7 +390,7 @@ test utf-6.62 {Tcl_UtfNext} testutfnext {
testutfnext \u8820G
} 3
test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext \u8820[testbytestring \xA0]
testutfnext [testbytestring \xE8\xA0\xA0\xA0]
} 3
test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} {
testutfnext \u8820[testbytestring \xD0]
@@ -476,12 +488,18 @@ test utf-6.87.0 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring u
test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xF0\x90\x80\x80]
} 4
test utf-6.88 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring} {
test utf-6.88.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xA0\xA0\x00]
} 1
test utf-6.89 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring} {
test utf-6.88.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xA0\xA0\x00]
} 2
test utf-6.89.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \x80\x80\x00]
} 1
test utf-6.89.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \x80\x80\x00]
} 2
test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xF4\x8F\xBF\xBF]
} 1
@@ -491,18 +509,30 @@ test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbyte
test utf-6.91 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring} {
testutfnext [testbytestring \xF4\x90\x80\x80]
} 1
test utf-6.92 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring} {
test utf-6.92.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xA0\xA0\xA0]
} 1
test utf-6.93 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring} {
test utf-6.92.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xA0\xA0\xA0]
} 3
test utf-6.93.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \x80\x80\x80]
} 1
test utf-6.94 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
test utf-6.93.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \x80\x80\x80]
} 3
test utf-6.94.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xA0\xA0\xA0\xA0]
} 1
test utf-6.95 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
test utf-6.94.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xA0\xA0\xA0\xA0]
} 3
test utf-6.95.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \x80\x80\x80\x80]
} 1
test utf-6.95.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \x80\x80\x80\x80]
} 3
test utf-6.96 {Tcl_UtfNext, read limits} testutfnext {
testutfnext G 0
} 0
@@ -600,18 +630,30 @@ test utf-6.121 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
test utf-6.122 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
testutfnext [testbytestring \xA0\xA0\xA0] 2
} 0
test utf-6.123 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
test utf-6.123.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xA0\xA0\xA0]G 3
} 1
test utf-6.124 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
test utf-6.123.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xA0\xA0\xA0]G 3
} 3
test utf-6.124.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xA0\xA0\xA0\xA0] 3
} 1
test utf-6.125 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
test utf-6.124.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xA0\xA0\xA0\xA0] 3
} 3
test utf-6.125.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xA0\xA0\xA0\xA0]G 4
} 1
test utf-6.126 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
test utf-6.125.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xA0\xA0\xA0\xA0]G 4
} 3
test utf-6.126.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
testutfnext [testbytestring \xA0\xA0\xA0\xA0\xA0] 4
} 1
test utf-6.126.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
testutfnext [testbytestring \xA0\xA0\xA0\xA0\xA0] 4
} 3
test utf-7.1 {Tcl_UtfPrev} testutfprev {
testutfprev {}
@@ -644,7 +686,7 @@ test utf-7.6 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8]
} 1
test utf-7.6.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A\u8820[testbytestring \xA0] 2
testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 2
} 1
test utf-7.6.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xF8\xA0\xA0] 2
@@ -659,13 +701,13 @@ test utf-7.7.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xF8\xA0\xA0] 2
} 1
test utf-7.8 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0]
testutfprev [testbytestring A\xA0]
} 1
test utf-7.8.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 2
testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 2
} 1
test utf-7.8.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xF8\xA0\xA0] 2
testutfprev [testbytestring A\xA0\xF8\xA0\xA0] 2
} 1
test utf-7.9 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF8\xA0]
@@ -698,7 +740,7 @@ test utf-7.11 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0]
} 1
test utf-7.11.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A\u8820[testbytestring \xA0] 3
testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 3
} 1
test utf-7.11.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE8\xA0\xF8\xA0] 3
@@ -716,13 +758,13 @@ test utf-7.12.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xF8\xA0] 3
} 1
test utf-7.13 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xA0]
testutfprev [testbytestring A\xA0\xA0]
} 2
test utf-7.13.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 3
testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 3
} 2
test utf-7.13.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xA0\xF8\xA0] 3
testutfprev [testbytestring A\xA0\xA0\xF8\xA0] 3
} 2
test utf-7.14 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF8\xA0\xA0]
@@ -755,7 +797,7 @@ test utf-7.16 {Tcl_UtfPrev} testutfprev {
testutfprev A\u8820
} 1
test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A\u8820[testbytestring \xA0] 4
testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 4
} 1
test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A\u8820[testbytestring \xF8] 4
@@ -770,28 +812,31 @@ test utf-7.17.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xA0\xF8] 4
} 3
test utf-7.18.0 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xA0\xA0]
testutfprev [testbytestring A\xA0\xA0\xA0]
} 3
test utf-7.18.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 4
testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 4
} 3
test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xA0\xA0\xF8] 4
testutfprev [testbytestring A\xA0\xA0\xA0\xF8] 4
} 3
test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF8\xA0\xA0\xA0]
testutfprev [testbytestring A\xF8\xA0\xA0\xA0]
} 4
test utf-7.20 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF2\xA0\xA0\xA0]
test utf-7.20.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
testutfprev [testbytestring A\xF2\xA0\xA0\xA0]
} 4
test utf-7.20.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
testutfprev [testbytestring A\xF2\xA0\xA0\xA0]
} 1
test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A\u8820[testbytestring \xA0]
testutfprev A[testbytestring \xE8\xA0\xA0\xA0]
} 4
test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xD0\xA0\xA0\xA0]
} 4
test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring} {
testutfprev A[testbytestring \xA0\xA0\xA0\xA0]
testutfprev [testbytestring A\xA0\xA0\xA0\xA0]
} 4
test utf-7.24 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
testutfprev A[testbytestring \xC0\x81]
@@ -844,9 +889,12 @@ test utf-7.37 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
test utf-7.38 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
testutfprev A[testbytestring \xE0\xA0\x80] 2
} 1
test utf-7.39 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring} {
test utf-7.39.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} {
testutfprev A[testbytestring \xF0\x90\x80\x80]
} 4
test utf-7.39.1 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring fullutf} {
testutfprev A[testbytestring \xF0\x90\x80\x80]
} 1
test utf-7.40.0 {Tcl_UtfPrev -- overlong sequence} {testutfprev testbytestring ucs2} {
testutfprev A[testbytestring \xF0\x90\x80\x80] 4
} 3
@@ -883,22 +931,25 @@ test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} tes
test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} {
testutfprev [testbytestring \xE8\xA0\x00] 2
} 0
test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
testutfprev A[testbytestring \xF4\x8F\xBF\xBF]
} 4
test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
testutfprev A[testbytestring \xF4\x8F\xBF\xBF]
} 1
test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4
} 3
test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4
} 1
test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3
} 2
test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3
} 1
test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
test utf-7.48.6 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 2
} 1
test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
@@ -942,54 +993,54 @@ test utf-8.7.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index \uD83D\uDE00G 0
} \uD83D
test utf-8.7.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index \uD83D\uDE00G 0
string index \U1F600G 0
} \U1F600
test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index \uD83D\uDE00G 0
string index \U1F600G 0
} \U1F600
test utf-8.8.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index \uD83D\uDE00G 1
} \uDE00
test utf-8.8.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index \uD83D\uDE00G 1
string index \U1F600G 1
} G
test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index \uD83D\uDE00G 1
string index \U1F600G 1
} {}
test utf-8.9.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
string index \uD83D\uDE00G 2
} G
test utf-8.9.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index \uD83D\uDE00G 2
string index \U1F600G 2
} {}
test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index \uD83D\uDE00G 2
string index \U1F600G 2
} G
test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
string index \U1F600G 0
} \uFFFD
test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index \U1F600G 0
} \U1F600
test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index \U1F600G 0
} \U1F600
test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
string index \U1F600G 1
} G
test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index \U1F600G 1
} G
test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index \U1F600G 1
} {}
test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
string index \U1F600G 2
} {}
test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
string index \U1F600G 2
} {}
test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
string index \U1F600G 2
} G
@@ -1003,55 +1054,55 @@ test utf-9.3.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 {
string range \uD83D\uDE00G 0 0
} \uD83D
test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
string range \uD83D\uDE00G 0 0
string range \U1F600G 0 0
} \U1F600
test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
string range \uD83D\uDE00G 0 0
string range \U1F600G 0 0
} \U1F600
test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
string range \uD83D\uDE00G 1 1
} \uDE00
test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
string range \uD83D\uDE00G 1 1
string range \U1F600G 1 1
} G
test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
string range \uD83D\uDE00G 1 1
string range \U1F600G 1 1
} {}
test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
string range \uD83D\uDE00G 2 2
} G
test utf-9.5.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
string range \uD83D\uDE00G 2 2
string range \U1F600G 2 2
} {}
test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
string range \uD83D\uDE00G 2 2
string range \U1F600G 2 2
} G
test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs2} {
string range \U1f600G 0 0
string range \U1F600G 0 0
} \uFFFD
test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs4} {
string range \U1f600G 0 0
test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
string range \U1F600G 0 0
} \U1F600
test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc utf16} {
string range \U1f600G 0 0
test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
string range \U1F600G 0 0
} \U1F600
test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} {
string range \U1f600G 1 1
string range \U1F600G 1 1
} G
test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} {
string range \U1f600G 1 1
test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
string range \U1F600G 1 1
} G
test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} {
string range \U1f600G 1 1
test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
string range \U1F600G 1 1
} {}
test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} {
string range \U1f600G 2 2
string range \U1F600G 2 2
} {}
test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} {
string range \U1f600G 2 2
test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
string range \U1F600G 2 2
} {}
test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} {
string range \U1f600G 2 2
test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
string range \U1F600G 2 2
} G
test utf-10.1 {Tcl_UtfBackslash: dst == NULL} {
@@ -1070,10 +1121,10 @@ test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring {
test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring {
expr {"\u4E216" eq "[testbytestring \xE4\xB8\xA1]6"}
} 1
test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {Uesc fullutf testbytestring} {
test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {fullutf testbytestring} {
expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"}
} 1
test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {Uesc fullutf testbytestring} {
test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {fullutf testbytestring} {
expr {"\U10E2165" eq "[testbytestring \xF4\x8E\x88\x96]5"}
} 1
@@ -1136,13 +1187,13 @@ bsCheck \U4E21 20001 Uesc
bsCheck \U004E21 20001 Uesc
bsCheck \U00004E21 20001 Uesc
bsCheck \U0000004E21 78 Uesc
bsCheck \U00110000 69632 {Uesc fullutf}
bsCheck \U01100000 69632 {Uesc fullutf}
bsCheck \U11000000 69632 {Uesc fullutf}
bsCheck \U0010FFFF 1114111 {Uesc fullutf}
bsCheck \U010FFFF0 1114111 {Uesc fullutf}
bsCheck \U10FFFF00 1114111 {Uesc fullutf}
bsCheck \UFFFFFFFF 1048575 {Uesc fullutf}
bsCheck \U00110000 69632 fullutf
bsCheck \U01100000 69632 fullutf
bsCheck \U11000000 69632 fullutf
bsCheck \U0010FFFF 1114111 fullutf
bsCheck \U010FFFF0 1114111 fullutf
bsCheck \U10FFFF00 1114111 fullutf
bsCheck \UFFFFFFFF 1048575 fullutf
test utf-11.1 {Tcl_UtfToUpper} {
string toupper {}
@@ -1159,7 +1210,7 @@ test utf-11.4 {Tcl_UtfToUpper} {
test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
string toupper \u10D0\u1C90
} \u1C90\u1C90
test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} {Uesc fullutf} {
test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} fullutf {
string toupper \U10428
} \U10400
test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf {
@@ -1187,7 +1238,7 @@ test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
test utf-12.6 {Tcl_UtfToLower low/high surrogate)} {
string tolower \uDC24\uD824
} \uDC24\uD824
test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} {Uesc fullutf} {
test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} fullutf {
string tolower \U10400
} \U10428
test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf {
@@ -1215,7 +1266,7 @@ test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
string totitle \uDC24\uD824
} \uDC24\uD824
test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} {Uesc fullutf} {
test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
string totitle \U10428\U10400
} \U10400\U10428
test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
@@ -1281,25 +1332,7 @@ test utf-19.1 {TclUniCharLen} -body {
test utf-20.1 {TclUniCharNcmp} ucs4 {
string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0]
} -1
test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} ucs2 {
set one [format %c 0xFFFF]
set two [format %c 0x10000]
set first [string compare $one $two]
string range $one 0 0
string range $two 0 0
set second [string compare $one $two]
expr {($first == $second) ? "agree" : "disagree"}
} agree
test utf-20.2.1 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} {utf16 knownBug} {
set one [format %c 0xFFFF]
set two [format %c 0x10000]
set first [string compare $one $two]
string range $one 0 0
string range $two 0 0
set second [string compare $one $two]
expr {($first == $second) ? "agree" : "disagree"}
} agree
test utf-20.2.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} ucs4 {
test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} {
set one [format %c 0xFFFF]
set two [format %c 0x10000]
set first [string compare $one $two]
@@ -1427,9 +1460,9 @@ UniCharCaseCmpTest > b a
UniCharCaseCmpTest > B a
UniCharCaseCmpTest > aBcB abca
UniCharCaseCmpTest < \uFFFF [format %c 0x10000] ucs4
UniCharCaseCmpTest < \uFFFF \U10000 {Uesc ucs4}
UniCharCaseCmpTest < \uFFFF \U10000 ucs4
UniCharCaseCmpTest > [format %c 0x10000] \uFFFF ucs4
UniCharCaseCmpTest > \U10000 \uFFFF {Uesc ucs4}
UniCharCaseCmpTest > \U10000 \uFFFF ucs4
test utf-26.1 {Tcl_UniCharDString} -setup {

File diff suppressed because it is too large Load Diff

View File

@@ -1041,7 +1041,7 @@ test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
rename getbytes {}
rename doit {}
} -result 0
test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
test var-22.1 {leak in localVarName internalrep: Bug 80304238ac} -setup {
proc getbytes {} {
lindex [split [memory info] \n] 3 3
}

View File

@@ -20,7 +20,7 @@ testConstraint dde 0
if {[testConstraint win]} {
if {![catch {
::tcltest::loadTestedCommands
set ::ddever [package require dde 1.4.3]
set ::ddever [package require dde 1.4.4]
set ::ddelib [info loaded "" Dde]}]} {
testConstraint dde 1
}
@@ -104,7 +104,7 @@ proc createChildProcess {ddeServerName args} {
# -------------------------------------------------------------------------
test winDde-1.0 {check if we are testing the right dll} {win dde} {
set ::ddever
} {1.4.3}
} {1.4.4}
test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
list [dde servername foobar] [dde servername] [dde servername self]

View File

@@ -39,7 +39,7 @@ testConstraint slowTest 0
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big
append big $big
append big $big
append big $big
append big $big