diff options
author | dgp <dgp@users.sourceforge.net> | 2016-04-20 16:44:13 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2016-04-20 16:44:13 (GMT) |
commit | 1bbd13e8395085f6afe23f0ac7d7cc91eae3cade (patch) | |
tree | deba5d0dcb60194537aea304ca412bd52ef3c1b6 /tests | |
parent | 66032e8a327e0498b0d8970307452f66c69be25c (diff) | |
parent | 049650b5952e5e5ee1997772750450305dccc6d7 (diff) | |
download | tcl-little.zip tcl-little.tar.gz tcl-little.tar.bz2 |
Merge 8.6.5little
Diffstat (limited to 'tests')
-rw-r--r-- | tests/clock.test | 26 | ||||
-rw-r--r-- | tests/compile.test | 42 | ||||
-rw-r--r-- | tests/env.test | 36 | ||||
-rw-r--r-- | tests/msgcat.test | 1 | ||||
-rw-r--r-- | tests/nre.test | 4 | ||||
-rw-r--r-- | tests/oo.test | 64 | ||||
-rw-r--r-- | tests/platform.test | 19 | ||||
-rw-r--r-- | tests/safe.test | 2 | ||||
-rw-r--r-- | tests/zlib.test | 6 |
9 files changed, 181 insertions, 19 deletions
diff --git a/tests/clock.test b/tests/clock.test index 2abeab9..615f3a8 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36931,11 +36931,37 @@ test clock-67.2 {Bug d19a30db57} -body { # error, not segfault tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222 } -returnCodes error -match glob -result * + test clock-67.3 {Bug d19a30db57} -body { # error, not segfault tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222 } -returnCodes error -match glob -result * +test clock-67.4 {Change format %x output on global locale change [Bug 4a0c163d24]} -setup { + package require msgcat + set current [msgcat::mclocale] +} -body { + msgcat::mclocale de_de + set res [regexp {^\d{2}\.\d{2}\.\d{4}$} [clock format 1 -locale current -format %x]] + msgcat::mclocale en_uk + lappend res [regexp {^\d{2}/\d{2}/\d{4}$} [clock format 1 -locale current -format %x]] +} -cleanup { + msgcat::mclocale $current +} -result {1 1} + +test clock-67.5 {Change scan %x output on global locale change [Bug 4a0c163d24]} -setup { + package require msgcat + set current [msgcat::mclocale] +} -body { + msgcat::mclocale de_de + set res [clock scan "01.01.1970" -locale current -format %x] + msgcat::mclocale en_uk + # This will fail without the bug fix, as still de_de is active + expr {$res == [clock scan "01/01/1970" -locale current -format %x]} +} -cleanup { + msgcat::mclocale $current +} -result {1} + # cleanup namespace delete ::testClock diff --git a/tests/compile.test b/tests/compile.test index d4a31d4..46e678a 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -765,7 +765,7 @@ test compile-18.24 {disassembler - basics} -returnCodes error -body { } -result "can't interpret \"\{\" as a lambda expression" test compile-18.25 {disassembler - basics} -body { dict keys [tcl::unsupported::getbytecode lambda {{} {}}] -} -result $bytecodekeys +} -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.26 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode proc } -match glob -result {wrong # args: should be "* proc procName"} @@ -778,7 +778,43 @@ test compile-18.28 {disassembler - basics} -setup { dict keys [tcl::unsupported::getbytecode proc chewonthis] } -cleanup { rename chewonthis {} +} -result "$bytecodekeys initiallinenumber sourcefile" +test compile-18.28.1 {disassembler - tricky bit} -setup { + eval [list proc chewonthis {} {}] +} -body { + dict keys [tcl::unsupported::getbytecode proc chewonthis] +} -cleanup { + rename chewonthis {} +} -result $bytecodekeys +test compile-18.28.2 {disassembler - tricky bit} -setup { + eval {proc chewonthis {} {}} +} -body { + dict keys [tcl::unsupported::getbytecode proc chewonthis] +} -cleanup { + rename chewonthis {} +} -result "$bytecodekeys initiallinenumber sourcefile" +test compile-18.28.3 {disassembler - tricky bit} -setup { + proc Proc {n a b} { + proc $n $a $b + } + Proc chewonthis {} {} +} -body { + dict keys [tcl::unsupported::getbytecode proc chewonthis] +} -cleanup { + rename Proc {} + rename chewonthis {} } -result $bytecodekeys +test compile-18.28.4 {disassembler - tricky bit} -setup { + proc Proc {n a b} { + tailcall proc $n $a $b + } + Proc chewonthis {} {} +} -body { + dict keys [tcl::unsupported::getbytecode proc chewonthis] +} -cleanup { + rename Proc {} + rename chewonthis {} +} -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.29 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode script } -match glob -result {wrong # args: should be "* script script"} @@ -807,7 +843,7 @@ test compile-18.35 {disassembler - basics} -setup { dict keys [tcl::unsupported::getbytecode method foo bar] } -cleanup { foo destroy -} -result $bytecodekeys +} -result "$bytecodekeys initiallinenumber sourcefile" test compile-18.36 {disassembler - basics} -returnCodes error -body { tcl::unsupported::getbytecode objmethod } -match glob -result {wrong # args: should be "* objmethod objectName methodName"} @@ -824,7 +860,7 @@ test compile-18.39 {disassembler - basics} -setup { dict keys [tcl::unsupported::getbytecode objmethod foo bar] } -cleanup { foo destroy -} -result $bytecodekeys +} -result "$bytecodekeys initiallinenumber sourcefile" test compile-19.0 {Bug 3614102: reset stack housekeeping} -body { # This will panic in a --enable-symbols=compile build, unless bug is fixed. diff --git a/tests/env.test b/tests/env.test index 83d99e0..9f59fbc 100644 --- a/tests/env.test +++ b/tests/env.test @@ -278,20 +278,20 @@ test env-5.4 {corner cases - unset the env array} -setup { } -cleanup { interp delete i } -result {1 a 1} -test env-5.5 {corner cases - cannot have null entries on Windows} {win} { +test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body { set env() a catch {set env()} -} {1} +} -result 1 -test env-6.1 {corner cases - add lots of env variables} {} { +test env-6.1 {corner cases - add lots of env variables} -body { set size [array size env] for {set i 0} {$i < 100} {incr i} { set env(BOGUS$i) $i } expr {[array size env] - $size} -} 100 +} -result 100 -test env-7.1 {[219226]: whole env array should not be unset by read} { +test env-7.1 {[219226]: whole env array should not be unset by read} -body { set n [array size env] set s [array startsearch env] while {[array anymore env $s]} { @@ -300,19 +300,29 @@ test env-7.1 {[219226]: whole env array should not be unset by read} { } array donesearch env $s return $n -} 0 -test env-7.2 {[219226]: links to env elements should not be removed by read} { +} -result 0 + +test env-7.2 {[219226]: links to env elements should not be removed by read} -body { apply {{} { set ::env(test7_2) ok upvar env(test7_2) elem set ::env(PATH) - try { - return $elem - } finally { - unset ::env(test7_2) - } + return $elem + }} +} -result ok + +test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body { + apply {{} { + catch {unset ::env(test7_3)} + proc foo args { + set ::env(test7_3) ok + } + trace add variable ::env(not_yet_existent) write foo + info exists ::env(not_yet_existent) + set ::env(not_yet_existent) "Now I'm here"; + return [info exists ::env(test7_3)] }} -} ok +} -result 1 # Restore the environment variables at the end of the test. diff --git a/tests/msgcat.test b/tests/msgcat.test index 6b965d1..8647f9c 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -995,6 +995,7 @@ namespace eval ::msgcat::test { mcloadedlocales clear } -cleanup { mcforgetpackage + after cancel set [namespace current]::resultvariable timeout } -body { mcpackageconfig set loadcmd [namespace code callbackfailproc] mclocale foo_bar diff --git a/tests/nre.test b/tests/nre.test index e512eac..9df5eb1 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -64,6 +64,10 @@ if {[testConstraint testnrelevels]} { namespace import testnre::* } +test nre-0.1 {levels while unwinding} { + testnreunwind +} {0 0 0} + test nre-1.1 {self-recursive procs} -setup { proc a i [makebody {a $i}] } -body { diff --git a/tests/oo.test b/tests/oo.test index c83e015..895f7ed 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -638,6 +638,57 @@ test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup { } -cleanup { cls destroy } -result {in destructor} +test oo-3.10 {Bug 3d96b7076e: killing the object's class in a method call} -setup { + oo::class create Super +} -body { + # Only reliably failed in a memdebug build + oo::class create Cls { + superclass Super + method mthd {} { + [self class] destroy + return ok + } + } + [Cls new] mthd +} -cleanup { + Super destroy +} -result ok +test oo-3.11 {Bug 3d96b7076e: killing the object's class in a method call} -setup { + oo::class create Super + oo::class create Sub { + superclass Super + } +} -body { + # Only reliably failed in a memdebug build + oo::class create Cls { + superclass Super + method mthd {} { + oo::objdefine [self] class Sub + Cls destroy + return ok + } + } + [Cls new] mthd +} -cleanup { + Super destroy +} -result ok +test oo-3.12 {Bug 3d96b7076e: killing the object's class in a method call} -setup { + oo::class create Super +} -body { + # Only reliably failed in a memdebug build + oo::class create Cls { + superclass Super + method mthd {} { + [self class] destroy + return ok + } + } + set o [Super new] + oo::objdefine $o mixin Cls + $o mthd +} -cleanup { + Super destroy +} -result ok test oo-4.1 {basic test of OO functionality: export} { set o [oo::object new] @@ -3620,6 +3671,19 @@ test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup { unset -nocomplain result fruitMetaclass destroy } -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear} +test oo-35.3 {Bug 593baa032c: superclass list teardown} { + # Bug makes this crash, especially with mem-debugging on + oo::class create B {} + oo::class create D {superclass B} + namespace eval [info object namespace D] [list [namespace which B] destroy] +} {} +test oo-35.4 {Bug 593baa032c: mixins list teardown} { + # Bug makes this crash, especially with mem-debugging on + oo::class create B {} + oo::class create D {mixin B} + namespace eval [info object namespace D] [list [namespace which B] destroy] +} {} + cleanupTests return diff --git a/tests/platform.test b/tests/platform.test index 6596975..c826444 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -1,4 +1,4 @@ -# The file tests the tcl_platform variable +# The file tests the tcl_platform variable and platform package. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and @@ -23,6 +23,10 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testCPUID [llength [info commands testcpuid]] +test platform-1.0 {tcl_platform(engine)} { + set tcl_platform(engine) +} {Tcl} + test platform-1.1 {TclpSetVariables: tcl_platform} { interp create i i eval {catch {unset tcl_platform(debug)}} @@ -30,7 +34,7 @@ test platform-1.1 {TclpSetVariables: tcl_platform} { set result [i eval {lsort [array names tcl_platform]}] interp delete i set result -} {byteOrder machine os osVersion pathSeparator platform pointerSize user wordSize} +} {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize} # Test assumes twos-complement arithmetic, which is true of virtually # everything these days. Note that this does *not* use wide(), and @@ -57,6 +61,17 @@ test platform-3.1 {CPU ID on Windows/UNIX} \ -match regexp \ -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$} +# The platform package makes very few promises, but does promise that the +# format of string it produces consists of two non-empty words separated by a +# hyphen. +package require platform +test platform-4.1 {format of platform::identify result} -match regexp -body { + platform::identify +} -result {^([^-]+-)+[^-]+$} +test platform-4.2 {format of platform::generic result} -match regexp -body { + platform::generic +} -result {^([^-]+-)+[^-]+$} + # cleanup cleanupTests diff --git a/tests/safe.test b/tests/safe.test index 859f352..94c1755 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -174,7 +174,7 @@ test safe-6.3 {test safe interpreters knowledge of the world} { } set r [lsearch -all -inline -not -exact $r "threaded"] lsort $r -} {byteOrder pathSeparator platform pointerSize wordSize} +} {byteOrder engine pathSeparator platform pointerSize wordSize} # More test should be added to check that hostname, nameofexecutable, aren't # leaking infos, but they still do... diff --git a/tests/zlib.test b/tests/zlib.test index b1d43fb..7a486ba 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -132,6 +132,12 @@ test zlib-7.6 {zlib stream} zlib { $s close lappend result $data } {{} 69f34b6a abcdeEDCBA..} +test zlib-7.7 {zlib stream: Bug 25842c161} -constraints zlib -body { + set s [zlib stream deflate] + $s put {} +} -cleanup { + catch {$s close} +} -result "" test zlib-8.1 {zlib transformation} -constraints zlib -setup { set file [makeFile {} test.gz] |