namespace-old.test

linux系统下的音频通信

# Functionality covered: this file contains slightly modified versions of
# the original tests written by Mike McLennan of Lucent Technologies for
# the procedures in tclNamesp.c that implement Tcl's basic support for
# namespaces. Other namespace-related tests appear in namespace.test
# and variable.test.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1997 Lucent Technologies
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) namespace-old.test 1.5 97/06/20 14:51:17

if {[string compare test [info procs test]] == 1} then {source defs}

# Clear out any namespaces called test_ns_*
catch {eval namespace delete [namespace children :: test_ns_*]}

test namespace-old-1.1 {usage for "namespace" command} {
    list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}

test namespace-old-1.2 {global namespace's name is "::" or {}} {
    list [namespace current] [namespace eval {} {namespace current}]
} {:: ::}

test namespace-old-1.3 {usage for "namespace eval"} {
    list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

test namespace-old-1.4 {create new namespaces} {
    list [lsort [namespace children :: test_ns_simple*]] \
	 [namespace eval test_ns_simple {}] \
	 [namespace eval test_ns_simple2 {}] \
         [lsort [namespace children :: test_ns_simple*]]
} {{} {} {} {::test_ns_simple ::test_ns_simple2}}

test namespace-old-1.5 {access a new namespace} {
    namespace eval test_ns_simple { namespace current }
} {::test_ns_simple}

test namespace-old-1.6 {usage for "namespace eval"} {
    list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

test namespace-old-1.7 {usage for "namespace eval"} {
    list [catch {namespace eval test_ns_xyzzy} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

test namespace-old-1.8 {command "namespace eval" concatenates args} {
    namespace eval test_ns_simple namespace current
} {::test_ns_simple}

test namespace-old-1.9 {add elements to a namespace} {
    namespace eval test_ns_simple {
        variable test_ns_x 0
        proc test {test_ns_x} {
            return "test: $test_ns_x"
        }
    }
} {}

test namespace-old-1.10 {commands in a namespace} {
    namespace eval test_ns_simple { info commands [namespace current]::*}
} {::test_ns_simple::test}

test namespace-old-1.11 {variables in a namespace} {
    namespace eval test_ns_simple { info vars [namespace current]::* }
} {::test_ns_simple::test_ns_x}

test namespace-old-1.12 {global vars are separate from locals vars} {
    list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
} {{test: 123} 0}

test namespace-old-1.13 {add to an existing namespace} {
    namespace eval test_ns_simple {
        variable test_ns_y 123
        proc _backdoor {cmd} {
            eval $cmd
        }
    }
} ""

test namespace-old-1.14 {commands in a namespace} {
    lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
} {::test_ns_simple::_backdoor ::test_ns_simple::test}

test namespace-old-1.15 {variables in a namespace} {
    lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
test namespace-old-1.16 {variables in a namespace} {
    lsort [info vars test_ns_simple::*]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

test namespace-old-1.17 {commands in a namespace are hidden} {
    list [catch "_backdoor {return yes!}" msg] $msg
} {1 {invalid command name "_backdoor"}}
test namespace-old-1.18 {using namespace qualifiers} {
    list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
} {0 yes!}
test namespace-old-1.19 {using absolute namespace qualifiers} {
    list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
} {0 yes!}

test namespace-old-1.20 {variables in a namespace are hidden} {
    list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
} {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
test namespace-old-1.21 {using namespace qualifiers} {
    list [catch "set test_ns_simple::test_ns_x" msg] $msg \
         [catch "set test_ns_simple::test_ns_y" msg] $msg
} {0 0 0 123}
test namespace-old-1.22 {using absolute namespace qualifiers} {
    list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
         [catch "set ::test_ns_simple::test_ns_y" msg] $msg
} {0 0 0 123}
test namespace-old-1.23 {variables can be accessed within a namespace} {
    test_ns_simple::_backdoor {
        variable test_ns_x
        variable test_ns_y
        return "$test_ns_x $test_ns_y"
    }
} {0 123}

test namespace-old-1.24 {setting global variables} {
    test_ns_simple::_backdoor {variable test_ns_x;  set test_ns_x "new val"}
    namespace eval test_ns_simple {set test_ns_x}
} {new val}

test namespace-old-1.25 {qualified variables don't need a global declaration} {
    namespace eval test_ns_another { variable test_ns_x 456 }
    set cmd {set ::test_ns_another::test_ns_x}
    list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
         [eval $cmd]
} {0 some-value some-value}

test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
    namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
    set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
    list [test_ns_simple::_backdoor $cmd] [eval $cmd]
} {{12 34} {12 34}}

test namespace-old-1.27 {can create commands with null names} {
    proc test_ns_simple:: {args} {return $args}
} {}

# -----------------------------------------------------------------------
# TEST: using "info" in namespace contexts
# -----------------------------------------------------------------------
test namespace-old-2.1 {querying:  info commands} {
    lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}

test namespace-old-2.2 {querying:  info procs} {
    lsort [test_ns_simple::_backdoor {info procs}]
} {{} _backdoor test}

test namespace-old-2.3 {querying:  info vars} {
    lsort [info vars test_ns_simple::*]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

test namespace-old-2.4 {querying:  info vars} {
    lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

test namespace-old-2.5 {querying:  info locals} {
    lsort [test_ns_simple::_backdoor {info locals}]
} {cmd}

test namespace-old-2.6 {querying:  info exists} {
    test_ns_simple::_backdoor {info exists test_ns_x}
} {0}

test namespace-old-2.7 {querying:  info exists} {
    test_ns_simple::_backdoor {info exists cmd}
} {1}

test namespace-old-2.8 {querying:  info args} {
    info args test_ns_simple::_backdoor
} {cmd}

test namespace-old-2.9 {querying:  info body} {
    string trim [info body test_ns_simple::test]
} {return "test: $test_ns_x"}

# -----------------------------------------------------------------------
# TEST: namespace qualifiers, namespace tail
# -----------------------------------------------------------------------
test namespace-old-3.1 {usage for "namespace qualifiers"} {
    list [catch "namespace qualifiers" msg] $msg
} {1 {wrong # args: should be "namespace qualifiers string"}}

test namespace-old-3.2 {querying:  namespace qualifiers} {
    list [namespace qualifiers ""] \
         [namespace qualifiers ::] \
         [namespace qualifiers x] \
         [namespace qualifiers ::x] \
         [namespace qualifiers foo::x] \
         [namespace qualifiers ::foo::bar::xyz]
} {{} {} {} {} foo ::foo::bar}

test namespace-old-3.3 {usage for "namespace tail"} {
    list [catch "namespace tail" msg] $msg
} {1 {wrong # args: should be "namespace tail string"}}

test namespace-old-3.4 {querying:  namespace tail} {
    list [namespace tail ""] \
         [namespace tail ::] \
         [namespace tail x] \
         [namespace tail ::x] \
         [namespace tail foo::x] \
         [namespace tail ::foo::bar::xyz]
} {{} {} x x x xyz}

# -----------------------------------------------------------------------
# TEST: delete commands and namespaces
# -----------------------------------------------------------------------
test namespace-old-4.1 {define test namespaces} {
    namespace eval test_ns_delete {
        namespace eval ns1 {
            variable var1 1
            proc cmd1 {} {return "cmd1"}
        }
        namespace eval ns2 {
            variable var2 2
            proc cmd2 {} {return "cmd2"}
        }
        namespace eval another {}
        lsort [namespace children]
    }
} {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}

test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
    list [catch {namespace delete} msg] $msg
} {0 {}}

test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
    set cmd {
        namespace eval test_ns_delete {namespace delete ns*}
    }
    list [catch $cmd msg] $msg
} {1 {unknown namespace "ns*" in namespace delete command}}

test namespace-old-4.4 {command "namespace delete" handles multiple args} {
    set cmd {
        namespace eval test_ns_delete {
            eval namespace delete \
                [namespace children [namespace current] ns?]
        }
    }
    list [catch $cmd msg] $msg [namespace children test_ns_delete]
} {0 {} ::test_ns_delete::another}

# -----------------------------------------------------------------------
# TEST: namespace hierarchy
# -----------------------------------------------------------------------
test namespace-old-5.1 {define nested namespaces} {
    set test_ns_var_global "var in ::"
    proc test_ns_cmd_global {} {return "cmd in ::"}

    namespace eval test_ns_hier1 {
        set test_ns_var_hier1 "particular to hier1"
        proc test_ns_cmd_hier1 {} {return "particular to hier1"}

        set test_ns_level 1
        proc test_ns_show {} {return "[namespace current]: 1"}

        namespace eval test_ns_hier2 {
            set test_ns_var_hier2 "particular to hier2"
            proc test_ns_cmd_hier2 {} {return "particular to hier2"}

            set test_ns_level 2
            proc test_ns_show {} {return "[namespace current]: 2"}

            namespace eval test_ns_hier3a {}
            namespace eval test_ns_hier3b {}
        }

        namespace eval test_ns_hier2a {}