From 9853c7fae6fa3aea71e0455341a8c5df187a01c3 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Tue, 10 Oct 2006 20:25:04 +0000 Subject: * tests/namespace-old.test (5.4 6.12,14,15): * tests/namespace.test (14.3,12 17.7,10 34.7): adapted tests to [Tip 278] functionality. * tests/namespace.test (namespace-14.5): refer to global vars explicitly (not what was being tested). Missed in the big patch. --- ChangeLog | 9 +++++++++ tests/namespace-old.test | 26 +++++++++++++++----------- tests/namespace.test | 37 ++++++++++++++++++++++++------------- 3 files changed, 48 insertions(+), 24 deletions(-) diff --git a/ChangeLog b/ChangeLog index b5cbefb..6190949 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2006-10-10 Miguel Sofer + + * tests/namespace-old.test (5.4 6.12,14,15): + * tests/namespace.test (14.3,12 17.7,10 34.7): adapted tests to + [Tip 278] functionality. + + * tests/namespace.test (namespace-14.5): refer to global vars + explicitly (not what was being tested). Missed in the big patch. + 2006-10-09 Miguel Sofer * generic/tclNamesp.c (Tcl_FindNamespaceVar): second change diff --git a/tests/namespace-old.test b/tests/namespace-old.test index 0fadd1f..7e273b2 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace-old.test,v 1.9 2004/08/27 14:39:14 dkf Exp $ +# RCS: @(#) $Id: namespace-old.test,v 1.9.8.1 2006/10/10 20:25:04 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -301,12 +301,13 @@ test namespace-old-5.3 {namespace qualifiers work in namespace command} { [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}] } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2} +# 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] \ @@ -491,11 +492,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}} test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 { @@ -504,21 +506,23 @@ test namespace-old-6.13 {one-level check for variable shadowing} { namespace eval test_ns_cache1 $trigger } {cache1 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 { unset 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}} +# 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 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 b485fee..bc602ba 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: namespace.test,v 1.56.2.2 2006/10/10 18:07:31 msofer Exp $ +# RCS: @(#) $Id: namespace.test,v 1.56.2.3 2006/10/10 20:25:04 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -558,11 +558,15 @@ test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} { [catch {namespace children test_ns_777} msg] $msg } } {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}} + +# TIP 278: secondary lookup disabled, results changed from {10 20} test namespace-14.3 {TclGetNamespaceForQualName, relative names} { 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 } -} {10 20} +} {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 {} @@ -577,9 +581,8 @@ test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up onl namespace eval bar {} } namespace eval test_ns_1 { - set l [list [catch {namespace delete test_ns_2::bar} msg] $msg] + list [catch {namespace delete test_ns_2::bar} msg] $msg } - set l } {1 {unknown namespace "test_ns_2::bar" in namespace delete command}} test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} { namespace eval test_ns_1::test_ns_2 { @@ -616,14 +619,16 @@ 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] } {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} { catch {namespace delete {expand}[namespace children :: test_ns_*]} 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) -} y + list $::msg [catch {set test_ns_1::(x)} msg] $msg +} {{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} { catch {namespace delete {expand}[namespace children :: test_ns_*]} list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg @@ -766,12 +771,14 @@ test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} { set x } } {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 { 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} { namespace eval test_ns_1 { list [catch {set wuzzat} msg] $msg @@ -783,6 +790,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} { namespace eval test_ns_1 {} proc test_ns {} { @@ -795,7 +804,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} { namespace eval test_ns_1 set a 1 namespace delete test_ns_1 set a -} 1 +} 0 catch {unset a} catch {unset x} @@ -1300,14 +1309,16 @@ test namespace-34.6 {NamespaceWhichCmd, -command is default} { [namespace which ::test_ns_2::cmd2] } } {::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} { 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 } -} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}} +} {0 {} ::test_ns_3::v3 ::test_ns_2::v2 0 {}} test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} { catch {namespace delete {expand}[namespace children :: test_ns_*]} -- cgit v0.12