Import Tcl 8.6.12
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"}]
|
||||
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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}]
|
||||
|
||||
@@ -728,7 +728,7 @@ test encoding-28.0 {all encodings load} -body {
|
||||
llength $name
|
||||
}
|
||||
return $count
|
||||
} -result 81
|
||||
} -result 83
|
||||
|
||||
runtests
|
||||
|
||||
|
||||
@@ -419,8 +419,8 @@ test env-8.0 {
|
||||
|
||||
|
||||
# cleanup
|
||||
rename getenv {}
|
||||
rename envrestore {}
|
||||
rename getenv {}
|
||||
rename envrestore {}
|
||||
rename envprep {}
|
||||
rename encodingrestore {}
|
||||
rename encodingswitch {}
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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}
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 *}
|
||||
|
||||
@@ -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::*
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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} {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
}]
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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} {
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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"]
|
||||
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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} {
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)$}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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} {
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -43,7 +43,7 @@ test split-1.8 {basic split commands} {
|
||||
foreach f [split {]\n} {}] {
|
||||
append x $f
|
||||
}
|
||||
return $x
|
||||
return $x
|
||||
}
|
||||
foo
|
||||
} {]\n}
|
||||
|
||||
@@ -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 {
|
||||
|
||||
@@ -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}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -37,7 +37,7 @@ test unixforkevent-1.1 {fork and test writeable event} \
|
||||
viewFile result.txt $myFolder
|
||||
} \
|
||||
-result {writable} \
|
||||
-cleanup {
|
||||
-cleanup {
|
||||
catch { removeFolder $myFolder }
|
||||
}
|
||||
|
||||
|
||||
@@ -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 }
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 {}
|
||||
|
||||
257
tests/utf.test
257
tests/utf.test
@@ -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 {
|
||||
|
||||
1303
tests/util.test
1303
tests/util.test
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
}
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user