Rebase tip-278 branch to workaround CVS conversion woes.

6 files changed, 53 insertions, 35 deletions

diff --git a/generic/tclVar.c b/generic/tclVar.c
index 7c8bb73..4f2d435 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -816,12 +816,8 @@ TclLookupSimpleVar(
 	    *indexPtr = -1;
 	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
 	} else {
-	    if (flags & TCL_AVOID_RESOLVERS) {
-		flags = (flags | TCL_NAMESPACE_ONLY);
-	    }
-	    if (flags & TCL_NAMESPACE_ONLY) {
-		*indexPtr = -2;
-	    }
+	    flags = (flags | TCL_NAMESPACE_ONLY);
+	    *indexPtr = -2;
 	}
 
 	/*
@@ -5709,6 +5705,10 @@ ObjFindNamespaceVar(
      * Find the namespace(s) that contain the variable.
      */
 
+    if (!(flags & TCL_GLOBAL_ONLY)) {
+	flags |= TCL_NAMESPACE_ONLY;
+    }
+
     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
 	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
 
diff --git a/tests/namespace-old.test b/tests/namespace-old.test
index 1d6a805..3f8737b 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -293,12 +293,13 @@ namespace eval test_ns_hier1 {
     namespace eval test_ns_hier2a {}
     namespace eval test_ns_hier2b {}
 }
+# TIP 278: secondary lookup disabled for vars, tests disabled with #
 test namespace-old-5.4 {nested namespaces can access global namespace} {
-    list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
+    list [namespace eval test_ns_hier1 {#set test_ns_var_global}] \
          [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
-         [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
+         [namespace eval test_ns_hier1::test_ns_hier2 {#set test_ns_var_global}] \
          [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
-} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
+} {{} {cmd in ::} {} {cmd in ::}}
 test namespace-old-5.5 {variables in different namespaces don't conflict} {
     list [set test_ns_hier1::test_ns_level] \
          [set test_ns_hier1::test_ns_hier2::test_ns_level]
@@ -468,11 +469,12 @@ test namespace-old-6.11 {commands affect all parent namespaces} {
     }
     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
 } {{cache2 version} {cache2 version}}
+# TIP 278: secondary lookup disabled, catch added, result changed from {global version}
 test namespace-old-6.12 {define test variables} {
     variable test_ns_cache_var "global version"
     set trigger {set test_ns_cache_var}
-    namespace eval test_ns_cache1 $trigger
-} {global version}
+    list [catch {namespace eval test_ns_cache1 $trigger} msg] $msg
+} {1 {can't read "test_ns_cache_var": no such variable}}
     set trigger {set test_ns_cache_var}
 test namespace-old-6.13 {one-level check for variable shadowing} {
     namespace eval test_ns_cache1 {
@@ -481,22 +483,24 @@ test namespace-old-6.13 {one-level check for variable shadowing} {
     namespace eval test_ns_cache1 $trigger
 } {cache1 version}
 variable ::test_ns_cache_var "global version"
+# TIP 278: secondary lookup disabled, catch added, result changed from {global version}
 test namespace-old-6.14 {deleting variables changes variable epoch} {
     namespace eval test_ns_cache1 {
         variable test_ns_cache_var "cache1 version"
     }
     list [namespace eval test_ns_cache1 $trigger] \
 	[namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
-	[namespace eval test_ns_cache1 $trigger]
-} {{cache1 version} {} {global version}}
+	[catch {namespace eval test_ns_cache1 $trigger}]
+} {{cache1 version} {} 1}
+# TIP 278: secondary lookup disabled, catch added, result changed
 test namespace-old-6.15 {define test namespaces} {
     namespace eval test_ns_cache2 {
         variable test_ns_cache_var "global cache2 version"
     }
     set trigger2 {set test_ns_cache2::test_ns_cache_var}
-    list [namespace eval test_ns_cache1 $trigger2] \
-         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
-} {{global cache2 version} {global version}}
+    catch {list [namespace eval test_ns_cache1 $trigger2] \
+	       [namespace eval test_ns_cache1::test_ns_cache2 $trigger]}
+} 1
 set trigger2 {set test_ns_cache2::test_ns_cache_var}
 test namespace-old-6.16 {public variables affect all parent namespaces} {
     variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
diff --git a/tests/namespace.test b/tests/namespace.test
index f6f817b..24c1c7d 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -46,9 +46,9 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} {
     set l {}
     lappend l [namespace current]
     namespace eval test_ns_1 {
-        lappend l [namespace current]
+        lappend ::l [namespace current]
         namespace eval foo {
-            lappend l [namespace current]
+            lappend ::l [namespace current]
         }
     }
     lappend l [namespace current]
@@ -633,6 +633,8 @@ test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup
              [catch {namespace children test_ns_777} msg] $msg
     }
 } -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
+
+# TIP 278: secondary lookup disabled, results changed from {10 20}
 test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
     variable v 10
@@ -644,9 +646,11 @@ test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
     }
 } -body {
     namespace eval test_ns_1 {
-        list $v $test_ns_2::v
+        # list $v $test_ns_2::v
+        list [catch {set v} msg] $msg  [catch {set test_ns_2::v} msg] $msg
     }
-} -result {10 20}
+} -result {1 {can't read "v": no such variable} 0 20}
+
 test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
     namespace eval test_ns_1::test_ns_2 {
         namespace eval foo {}
@@ -707,15 +711,17 @@ test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for
     proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
     lappend l [test_ns_1::test_ns_2:: hello]
 } -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
+
+# TIP 278: secondary lookup disabled, added catch, result changed from y
 test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
 } -body {
     namespace eval test_ns_1 {
         variable {}
-        set test_ns_1::(x) y
+        catch {set test_ns_1::(x) y} ::msg
     }
-    set test_ns_1::(x)
-} -result y
+    list $::msg [catch {set test_ns_1::(x)} msg] $msg
+} -result {{can't set "test_ns_1::(x)": parent namespace doesn't exist} 1 {can't read "test_ns_1::(x)": no such variable}}
 test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
 } -returnCodes error -body {
@@ -888,13 +894,15 @@ test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
         set x
     }
 } -result {777}
+
+# TIP 278: secondary lookup disabled, catch added, result changed from 314159
 test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
     namespace eval test_ns_1 {
 	variable x 777
         unset x
-        set x  ;# must be global x now
+        list [catch {set x} msg] $msg  ;# must not be global x now
     }
-} {314159}
+} {1 {can't read "x": no such variable}}
 test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
     namespace eval test_ns_1 {
         set wuzzat
@@ -906,6 +914,8 @@ test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
     }
     set test_ns_1::a
 } {hello}
+
+# TIP 278: secondary lookup disabled, result changed from 1
 test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
     namespace eval test_ns_1 {}
 } -body {
@@ -919,7 +929,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -
     namespace eval test_ns_1 set a 1
     namespace delete test_ns_1
     return $a
-} -result 1
+} -result 0
 catch {unset a}
 catch {unset x}
 
@@ -1540,6 +1550,8 @@ test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup {
              [namespace which ::test_ns_2::cmd2]
     }
 } -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
+
+# TIP 278: secondary lookup disabled, catch added, result changed
 test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
     catch {namespace delete {*}[namespace children test_ns_*]}
     namespace eval test_ns_1 {
@@ -1559,12 +1571,12 @@ test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
     }
 } -body {
     namespace eval test_ns_3 {
-        list [namespace which -variable env] \
+        list [catch {namespace which -variable env } msg] $msg \
              [namespace which -variable v3] \
              [namespace which -variable ::test_ns_2::v2] \
              [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
     }
-} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
+} -result {0 {} ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
 
 test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
diff --git a/tests/parse.test b/tests/parse.test
index 287c392..d36472e 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -376,12 +376,12 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints {
 	return "new result"
     }
     set handler1 [testasync create async1]
-    set aresult xxx
-    set acode yyy
+    set ::aresult xxx
+    set ::acode yyy
 } -cleanup {
     testasync delete
 } -body {
-    list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult
+    list [testevalobjv 0 testasync mark $handler1 original 0] $::acode $::aresult
 } -result {{new result} 0 original}
 test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv {
     list [catch {testevalobjv 0 error message} msg] $msg
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 728a018..cd3c621 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -544,6 +544,7 @@ set notReadableDir [file join [temporaryDirectory] notreadable]
 set notWriteableDir [file join [temporaryDirectory] notwriteable]
 makeDirectory notreadable
 makeDirectory notwriteable
+
 switch -- $::tcl_platform(platform) {
     unix {
 	file attributes $notReadableDir -permissions 00333
diff --git a/tests/var.test b/tests/var.test
index 9816d98..e32dbcf 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -247,10 +247,11 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
 	catch {unset ::test_ns_var::vv}
 	proc p {} {
 	    # create namespace var vv linked to global a
-	    testupvar 1 a {} vv namespace
+	    testupvar 2 a {} vv namespace 
 	}
 	p
     }
+    # Modified: that should create a global var according to the docs!
     list $test_ns_var::vv [set test_ns_var::vv 123] $a
 } -result {456 123 123}
 test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
@@ -442,7 +443,7 @@ test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
     set six  666
     namespace eval test_ns_var {
         variable five 5 six
-        lappend a $five
+        lappend ::a $five
     }
     lappend a $test_ns_var::five \
         [set test_ns_var::six 6] [set test_ns_var::six] $six
@@ -469,9 +470,9 @@ test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, l
     set a ""
     namespace eval test_ns_var {
         variable eight 8
-        lappend a $eight
+        lappend ::a $eight
         variable eight
-        lappend a $eight
+        lappend ::a $eight
     }
     set a
 } {8 8}