var.test

linux系统下的音频通信

    namespace eval test_ns_var {
        variable boeing 777
    }
    proc p {} {
        global ::test_ns_var::boeing
        set boeing
    }
    p
} {777}
test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
    namespace eval test_ns_var {
        namespace eval test_ns_nested {
            variable java java
        }
        proc p {} {
            global ::test_ns_var::test_ns_nested::java
            set java
        }
    }
    test_ns_var::p
} {java}
test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
    set ::test_ns_var::test_ns_nested:: 24
    proc p {} {
        global ::test_ns_var::test_ns_nested::
        set {}
    }
    p
} {24}

test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} {
    catch {namespace delete test_ns_var}
    namespace eval test_ns_var {
        variable one 1
    }
    list [info vars test_ns_var::*] [set test_ns_var::one]
} {::test_ns_var::one 1}
test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
    set two 2222222
    namespace eval test_ns_var {
        variable two
    }
    list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
} {0 1 {can't read "test_ns_var::two": no such variable}}
test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
    namespace eval test_ns_var {
        variable two 2
    }
    list [info vars test_ns_var::*] \
         [namespace eval test_ns_var {set two}]
} {{::test_ns_var::two ::test_ns_var::one} 2}
test var-7.4 {Tcl_VariableObjCmd, list of vars} {
    namespace eval test_ns_var {
        variable three 3 four 4
    }
    list [info vars test_ns_var::*] \
         [namespace eval test_ns_var {expr $three+$four}]
} {{::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one} 7}
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
    catch {unset a}
    catch {unset five}
    catch {unset six}
    set a ""
    set five 555
    set six  666
    namespace eval test_ns_var {
        variable five 5 six
        lappend a $five
    }
    lappend a $test_ns_var::five \
        [set test_ns_var::six 6] [set test_ns_var::six] $six
    catch {unset five}
    catch {unset six}
    set a
} {5 5 6 6 666}
catch {unset newvar}
test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} {
    namespace eval test_ns_var {
        variable ::newvar cheers!
    }
    set newvar
} {cheers!}
catch {unset newvar}
test var-7.7 {Tcl_VariableObjCmd, bad var name} {
    namespace eval test_ns_var {
        list [catch {variable sev:::en 7} msg] $msg
    }
} {1 {can't define "sev:::en": parent namespace doesn't exist}}
test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
    set a ""
    namespace eval test_ns_var {
        variable eight 8
        lappend a $eight
        variable eight
        lappend a $eight
    }
    set a
} {8 8}
test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} {
    catch {namespace delete test_ns_var2}
    set a ""
    namespace eval test_ns_var2 {
        variable x 123
        variable y
        variable z
    }
    lappend a [info vars test_ns_var2::*]
    lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \
        [info exists test_ns_var2::z]
    lappend a [list [catch {set test_ns_var2::y} msg] $msg]
    lappend a [info vars test_ns_var2::*]
    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
    lappend a [set test_ns_var2::y hello]
    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
    lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
    lappend a [info vars test_ns_var2::*]
    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
    lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
    lappend a [namespace delete test_ns_var2]
    set a
} {{::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z} 1 0 0\
{1 {can't read "test_ns_var2::y": no such variable}}\
{::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z} 0 0\
hello 1 0\
{0 {}}\
{::test_ns_var2::x ::test_ns_var2::z} 0 0\
{1 {can't unset "test_ns_var2::z": no such variable}}\
{}}
test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
    namespace eval test_ns_var {
        proc p {} {
            variable eight
            list [set eight] [info vars]
        }
        p
    }
} {8 eight}
test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
    proc p {} {   ;# note this proc is at global :: scope
        variable test_ns_var::eight
        list [set eight] [info vars]
    }
    p
} {8 eight}
test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
    namespace eval test_ns_var {
        variable {} {My name is empty}
    }
    proc p {} {   ;# note this proc is at global :: scope
        variable test_ns_var::
        list [set {}] [info vars]
    }
    p
} {{My name is empty} {{}}}

test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
    catch {namespace delete test_ns_var}
    catch {unset a}
    namespace eval test_ns_var {
        variable v 123
        variable info ""

        proc traceUnset {name1 name2 op} {
            variable info
            set info [concat $info [list $name1 $name2 $op]]
        }

        trace var v u [namespace code traceUnset]
    }
    list [unset test_ns_var::v] $test_ns_var::info
} {{} {test_ns_var::v {} u}}

if {[info commands testsetnoerr] == {}} {
    puts "This application hasn't been compiled with the \"testsetnoerr\""
    puts "command, so I can't test TclSetVar etc."
} else {
test var-9.1 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
	testsetnoerr v 1
} 1
test var-9.2 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
	catch {unset v}
	list [catch {testsetnoerr v} res] $res;
} {1 {before get}}
test var-9.3 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
	catch {unset arr}
	set arr(1) 1;
	list [catch {testsetnoerr arr} res] $res;
} {1 {before get}}
test var-9.4 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
	namespace eval ns {variable v nsv}
	testsetnoerr ns::v;
} nsv;
test var-9.5 {behaviour of TclGetVar without TCL_LEAVE_ERR_MSG flag} {
	catch {namespace delete ns}
	list [catch {testsetnoerr ns::v} res] $res;
} {1 {before get}}
test var-9.6 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
	catch {unset arr}
	set arr(1) 1;
	list [catch {testsetnoerr arr 2} res] $res;
} {1 {before set}}
test var-9.7 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
	catch {unset arr}
	set arr(1) 1;
	list [catch {testsetnoerr arr 2} res] $res;
} {1 {before set}}
test var-9.8 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
    # this test currently fails, should not...
    # (some namespace function resets the interp while it should not)
    catch {namespace delete ns}
    list [catch {testsetnoerr ns::v 1} res] $res;
} {1 {before set}}
test var-9.9 {behaviour of TclSetVar without TCL_LEAVE_ERR_MSG flag} {
    proc readonly args {error "read-only"}
    set v 456
    trace var v w readonly
    list [catch {testsetnoerr v 2} msg] $msg
} {1 {before set}}
}

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename p ""}
catch {namespace delete test_ns_var}
catch {namespace delete test_ns_var2}
catch {unset xx}
catch {unset x}
catch {unset y}
catch {unset i}
catch {unset a}
catch {unset xxxxx}
catch {unset aaaaa}