summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-03-10 15:31:47 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-03-10 15:31:47 (GMT)
commit226803c44fa0615537f00d627caf13edc292ae67 (patch)
tree3d762efe761d77443255b67980b016728e90a1dc
parent5dcb1f9d84afc356cd64d639642cf059ef6c566c (diff)
downloadtcl-226803c44fa0615537f00d627caf13edc292ae67.zip
tcl-226803c44fa0615537f00d627caf13edc292ae67.tar.gz
tcl-226803c44fa0615537f00d627caf13edc292ae67.tar.bz2
Fix most of the failing tests (some of which were due to breakage done to the
parser used in auto_mkIndex; never a good idea to delete the ::tcl NS!)
-rw-r--r--library/auto.tcl9
-rw-r--r--tests/interp.test10
-rw-r--r--tests/nre.test30
3 files changed, 31 insertions, 18 deletions
diff --git a/library/auto.tcl b/library/auto.tcl
index c84ab58..4bd860d 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -304,7 +304,14 @@ namespace eval auto_mkindex_parser {
$parser hide namespace
$parser hide eval
$parser hide puts
- $parser invokehidden namespace delete ::
+ foreach ns [$parser invokehidden namespace children ::] {
+ # MUST NOT DELETE "::tcl" OR BAD THINGS HAPPEN!
+ if {$ns eq "::tcl"} continue
+ $parser invokehidden namespace delete $ns
+ }
+ foreach cmd [$parser invokehidden info commands ::*] {
+ $parser invokehidden rename $cmd {}
+ }
$parser invokehidden proc unknown {args} {}
# We'll need access to the "namespace" command within the
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/nre.test b/tests/nre.test
index c0d0aaa..2c97edc 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 {
@@ -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: