diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/interp.test | 10 | ||||
| -rw-r--r-- | tests/namespace.test | 4 | ||||
| -rw-r--r-- | tests/nre.test | 34 |
3 files changed, 27 insertions, 21 deletions
diff --git a/tests/interp.test b/tests/interp.test index fd6090e..35f6824 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -2328,17 +2328,17 @@ test interp-28.1 {getting fooled by slave's namespace ?} -setup { } -result {} test interp-28.2 {master's nsName cache should not cross} -setup { set i [interp create] + $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}} } -body { $i eval { set x {namespace children ::} set y [list namespace children ::] - namespace delete {*}[{*}$y] + namespace delete {*}[filter [{*}$y]] set j [interp create] - $j eval {namespace delete {*}[namespace children ::]} + $j alias filter filter + $j eval {namespace delete {*}[filter [namespace children ::]]} namespace eval foo {} - set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]] - interp delete $j - set res + list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]] } } -cleanup { interp delete $i diff --git a/tests/namespace.test b/tests/namespace.test index fe087a5..9d7cb59 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -896,7 +896,7 @@ test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} { } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body { namespace wombat {} -} -returnCodes error -match glob -result {bad option "wombat": must be *} +} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *} test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { namespace ch :: test_ns_* } {} @@ -1013,7 +1013,7 @@ test namespace-25.1 {NamespaceEvalCmd, bad args} { } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-25.2 {NamespaceEvalCmd, bad args} -body { namespace test_ns_1 -} -returnCodes error -match glob -result {bad option "test_ns_1": must be *} +} -returnCodes error -match glob -result {unknown or ambiguous subcommand "test_ns_1": must be *} catch {unset v} test namespace-25.3 {NamespaceEvalCmd, new namespace} { set v 123 diff --git a/tests/nre.test b/tests/nre.test index c0d0aaa..295f02e 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -60,7 +60,7 @@ if {[testConstraint testnrelevels]} { } namespace import testnre::* } - + test nre-1.1 {self-recursive procs} -setup { proc a i [makebody {a $i}] } -body { @@ -161,7 +161,7 @@ test nre-5.1 {[namespace eval] is not recursive} -setup { namespace delete ::foo } -constraints { testnrelevels -} -result {{0 2 2 2} 0} +} -result {{0 3 2 2} 0} test nre-5.2 {[namespace eval] is not recursive} -setup { namespace eval ::foo { @@ -174,7 +174,7 @@ test nre-5.2 {[namespace eval] is not recursive} -setup { namespace delete ::foo } -constraints { testnrelevels -} -result {{0 2 2 2} 0} +} -result {{0 3 2 2} 0} test nre-6.1 {[uplevel] is not recursive} -setup { proc a i [makebody {uplevel 1 [list a $i]}] @@ -411,23 +411,24 @@ test nre-oo.5 {really deep calls in oo - forwards} -setup { # NASTY BUG found by tcllib's interp package # -test nre-X.1 {eval in wrong interp} { +test nre-X.1 {eval in wrong interp} -setup { set i [interp create] - set res [$i eval { + $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}} +} -body { + $i eval { set x {namespace children ::} set y [list namespace children ::] - namespace delete {*}[{*}$y] + namespace delete {*}[filter [{*}$y]] set j [interp create] - $j eval {namespace delete {*}[namespace children ::]} + $j alias filter filter + $j eval {namespace delete {*}[filter [namespace children ::]]} namespace eval foo {} - set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]] - interp delete $j - set res - }] + list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]] + } +} -cleanup { interp delete $i - set res -} {::foo ::foo {} {}} - +} -result {::foo ::foo {} {}} + # cleanup ::tcltest::cleanupTests @@ -437,3 +438,8 @@ if {[testConstraint testnrelevels]} { } return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |