diff options
author | gahr <gahr@gahr.ch> | 2016-05-23 11:40:10 (GMT) |
---|---|---|
committer | gahr <gahr@gahr.ch> | 2016-05-23 11:40:10 (GMT) |
commit | 350efb174951691350ccfae2352f7a59775d604e (patch) | |
tree | bf6524a31d689158f8511caf4f7c943f452ae213 /tests | |
parent | bcaca1bf7b9159ba02add2f07ddff74fc872093f (diff) | |
parent | c559956bdbeb3be7c36bff03736f2f58b326085b (diff) | |
download | tcl-350efb174951691350ccfae2352f7a59775d604e.zip tcl-350efb174951691350ccfae2352f7a59775d604e.tar.gz tcl-350efb174951691350ccfae2352f7a59775d604e.tar.bz2 |
Merge trunkgahr_tip_447
Diffstat (limited to 'tests')
-rw-r--r-- | tests/assemble.test | 86 | ||||
-rw-r--r-- | tests/namespace.test | 39 | ||||
-rw-r--r-- | tests/registry.test | 4 |
3 files changed, 127 insertions, 2 deletions
diff --git a/tests/assemble.test b/tests/assemble.test index 5c226cd..d17bfd9 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -3279,6 +3279,92 @@ test assemble-51.4 {memory leak testing} memory { } } } 0 + +test assemble-52.1 {Bug 3154ea2759} { + apply {{} { + # Needs six exception ranges to force the range allocations to use the + # malloced store. + ::tcl::unsupported::assemble { + beginCatch @badLabel + push error + push testing + invokeStk 2 + pop + push 0 + jump @okLabel + label @badLabel + push 1; # should be pushReturnCode + label @okLabel + endCatch + pop + + beginCatch @badLabel2 + push error + push testing + invokeStk 2 + pop + push 0 + jump @okLabel2 + label @badLabel2 + push 1; # should be pushReturnCode + label @okLabel2 + endCatch + pop + + beginCatch @badLabel3 + push error + push testing + invokeStk 2 + pop + push 0 + jump @okLabel3 + label @badLabel3 + push 1; # should be pushReturnCode + label @okLabel3 + endCatch + pop + + beginCatch @badLabel4 + push error + push testing + invokeStk 2 + pop + push 0 + jump @okLabel4 + label @badLabel4 + push 1; # should be pushReturnCode + label @okLabel4 + endCatch + pop + + beginCatch @badLabel5 + push error + push testing + invokeStk 2 + pop + push 0 + jump @okLabel5 + label @badLabel5 + push 1; # should be pushReturnCode + label @okLabel5 + endCatch + pop + + beginCatch @badLabel6 + push error + push testing + invokeStk 2 + pop + push 0 + jump @okLabel6 + label @badLabel6 + push 1; # should be pushReturnCode + label @okLabel6 + endCatch + pop + } + }} +} {}; # must not crash rename fillTables {} rename assemble {} diff --git a/tests/namespace.test b/tests/namespace.test index 47c8001..5c5783b 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -2953,6 +2953,45 @@ test namespace-54.1 {leak on namespace deletion} -constraints {memory} \ test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} { info class [format %s constructor] oo::object } "" + +test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} { + namespace eval ::testing { + proc abc {} {} + proc def {} {} + trace add command abc delete "rename ::testing::def {}; #" + trace add command def delete "rename ::testing::abc {}; #" + } + namespace delete ::testing +} {} +test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} { + namespace eval ::testing { + namespace eval abc {proc xyz {} {}} + namespace eval def {proc xyz {} {}} + trace add command abc::xyz delete "namespace delete ::testing::def {}; #" + trace add command def::xyz delete "namespace delete ::testing::abc {}; #" + } + namespace delete ::testing +} {} +test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} { + namespace eval ::testing { + variable gone {} + oo::class create CB { + variable cmd + constructor other {set cmd $other} + destructor {rename $cmd {}; lappend ::testing::gone $cmd} + } + namespace eval abc { + ::testing::CB create def ::testing::abc::ghi + ::testing::CB create ghi ::testing::abc::def + } + namespace delete abc + try { + return [lsort $gone] + } finally { + namespace delete ::testing + } + } +} {::testing::abc::def ::testing::abc::ghi} # cleanup catch {rename cmd1 {}} diff --git a/tests/registry.test b/tests/registry.test index 0f78212..2072559 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -19,7 +19,7 @@ testConstraint reg 0 if {[testConstraint win]} { if {![catch { ::tcltest::loadTestedCommands - set ::regver [package require registry 1.3.1] + set ::regver [package require registry 1.3.2] }]} { testConstraint reg 1 } @@ -33,7 +33,7 @@ testConstraint english [expr { test registry-1.0 {check if we are testing the right dll} {win reg} { set ::regver -} {1.3.1} +} {1.3.2} test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} |