send.test

linux系统下的音频通信

	testsend prop root InterpRegistry "10234 bogus\n"
	set result [list [catch {send bogus bogus command} msg] $msg]
	winfo interps
	tk appname tktest
	set result
    } {1 {no application named "bogus"}}
    interp delete t_s_1
}
test send-8.17 {Tk_SendCmd procedure, deferring events} {nonPortable} {
    # Non-portable because some window managers ignore "raise"
    # requests so can't guarantee that new app's window won't
    # obscure .f, thereby masking the Expose event.

    setupbg
    set app [dobg {tk appname}]
    raise .		; # Don't want new app obscuring .f
    catch {destroy .f}
    frame .f
    place .f -x 0 -y 0
    bind .f <Expose> {set a exposed}
    set a {no event yet}
    set result ""
    lappend result [send $app send [list [tk appname]] set a]
    lappend result $a
    update
    cleanupbg
    lappend result $a
} {{no event yet} {no event yet} exposed}
test send-8.18 {Tk_SendCmd procedure, error in remote app} {
    setupbg
    set app [dobg {tk appname}]
    set result [string tolower [list [catch {send $app open bad_name} msg] \
	    $msg $errorInfo $errorCode]]
    cleanupbg
    set result
} {1 {couldn't open "bad_name": no such file or directory} {couldn't open "bad_name": no such file or directory
    while executing
"open bad_name"
    invoked from within
"send $app open bad_name"} {posix enoent {no such file or directory}}}
test send-8.19 {Tk_SendCmd, using modal timeouts} {
    setupbg
    set app [dobg {tk appname}]
    set x no
    set result ""
    after 0 {set x yes}
    lappend result [send $app {concat x y z}]
    lappend result $x
    update
    cleanupbg
    lappend result $x
} {{x y z} no yes}

tk appname tktest
catch {destroy .f}
frame .f
set id [string range [winfo id .f] 2 end]
if $gotTestCmds {
    test send-9.1 {Tk_GetInterpNames procedure} {
	testsend prop root InterpRegistry \
		"$commId tktest\nfoo bar\n$commId tktest\n$id frame .f\n\n\n"
	list [winfo interps] [testsend prop root InterpRegistry]
    } "{tktest tktest {frame .f}} {$commId tktest\n$commId tktest\n$id frame .f
}"
    test send-9.2 {Tk_GetInterpNames procedure} {
	testsend prop root InterpRegistry \
		"$commId tktest\nfoobar\n$commId gorp\n"
	list [winfo interps] [testsend prop root InterpRegistry]
    } "tktest {$commId tktest\n}"
    test send-9.3 {Tk_GetInterpNames procedure} {
	testsend prop root InterpRegistry {}
	list [winfo interps] [testsend prop root InterpRegistry]
    } {{} {}}

    testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"
    test send-10.1 {SendEventProc procedure, bogus comm property} {
	testsend prop comm Comm {abc def}
	testsend prop comm Comm {}
	update
    } {}
    test send-10.2 {SendEventProc procedure, simultaneous messages} {
	testsend prop comm Comm \
		"c\n-n tktest\n-s set a 44\nc\n-n tktest\n-s set b 45\n"
	set a null
	set b xyzzy
	update
	list $a $b
    } {44 45}
    test send-10.3 {SendEventProc procedure, simultaneous messages} {
	testsend prop comm Comm \
		"c\n-n tktest\n-s set a newA\nr\n-s [testsend serial]\n-r 12345\nc\n-n tktest\n-s set b newB\n"
	set a null
	set b xyzzy
	set x [send dummy bogus]
	list $x $a $b
    } {12345 newA newB}
    test send-10.4 {SendEventProc procedure, leading nulls, bogus commands} {
	testsend prop comm Comm \
		"\n\nx\n-bogus\n\nc\n-n tktest\n-s set a 44\n"
	set a null
	update
	set a
    } {44}
    test send-10.5 {SendEventProc procedure, extraneous command options} {
	testsend prop comm Comm \
		"c\n-n tktest\n-x miscellanous\n-y who knows?\n-s set a new\n"
	set a null
	update
	set a
    } {new}
    test send-10.6 {SendEventProc procedure, unknown interpreter} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n unknown\n-r $id 44\n-s set a new\n"
	set a null
	update
	list [testsend prop [winfo id .f] Comm] $a
    } "{\nr\n-s 44\n-r receiver never heard of interpreter \"unknown\"\n-c 1\n} null"
    test send-10.7 {SendEventProc procedure, error in script} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-r $id 62\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
	update
	testsend prop [winfo id .f] Comm
    } {
r
-s 62
-r test error
-i Initial errorInfo
    ("foreach" body line 1)
    invoked from within
"foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}"
-e test code
-c 1
}
    test send-10.8 {SendEventProc procedure, exceptional return} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-r $id 62\n-s break\n"
	update
	testsend prop [winfo id .f] Comm
    } {
r
-s 62
-r 
-c 3
}
    test send-10.9 {SendEventProc procedure, empty return} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-r $id 62\n-s concat\n"
	update
	testsend prop [winfo id .f] Comm
    } {
r
-s 62
-r 
}
    test send-10.10 {SendEventProc procedure, asynchronous calls} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
	update
	testsend prop [winfo id .f] Comm
    } {}
    test send-10.11 {SendEventProc procedure, exceptional return} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-s break\n"
	update
	testsend prop [winfo id .f] Comm
    } {}
    test send-10.12 {SendEventProc procedure, empty return} {
	testsend prop [winfo id .f] Comm {}
	testsend prop comm Comm \
		"c\n-n tktest\n-s concat\n"
	update
	testsend prop [winfo id .f] Comm
    } {}
    test send-10.13 {SendEventProc procedure, return processing} {
	testsend prop comm Comm \
		"r\n-c 1\n-e test1\n-i test2\n-r test3\n-s [testsend serial]\n"
	list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
    } {1 test3 {test2
    invoked from within
"send dummy foo"} test1}
    test send-10.14 {SendEventProc procedure, extraneous return options} {
	testsend prop comm Comm \
		"r\n-x test1\n-y test2\n-r result\n-s [testsend serial]\n"
	list [catch {send dummy foo} msg] $msg
    } {0 result}
    test send-10.15 {SendEventProc procedure, serial number} {
	testsend prop comm Comm \
		"r\n-r response\n"
	list [catch {send dummy foo} msg] $msg
    } {1 {target application died or uses a Tk version before 4.0}}
    test send-10.16 {SendEventProc procedure, serial number} {
	testsend prop comm Comm \
		"r\n-r response\n\n-s 0"
	list [catch {send dummy foo} msg] $msg
    } {1 {target application died or uses a Tk version before 4.0}}
    test send-10.17 {SendEventProc procedure, errorCode and errorInfo} {
	testsend prop comm Comm \
		"r\n-i test1\n-e test2\n-c 4\n-s [testsend serial]\n"
	set errorCode oldErrorCode
	set errorInfo oldErrorInfo
	list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
    } {4 {} oldErrorInfo oldErrorCode}
    test send-10.18 {SendEventProc procedure, send kills application} {
	setupbg
	dobg {tk appname t_s_3}
	set x [list [catch {send t_s_3 destroy .} msg] $msg]
	cleanupbg
	set x
    } {0 {}}
    test send-10.19 {SendEventProc procedure, send exits} {
	setupbg
	dobg {tk appname t_s_3}
	set x [list [catch {send t_s_3 exit} msg] $msg]
	close $fd
	set x
    } {1 {target application died}}

    test send-11.1 {AppendPropCarefully and AppendErrorProc procedures} {
	testsend prop root InterpRegistry "0x21447 dummy\n"
	list [catch {send dummy foo} msg] $msg
    } {1 {no application named "dummy"}}
    test send-11.2 {AppendPropCarefully and AppendErrorProc procedures} {
	testsend prop comm Comm "c\n-r0x123 44\n-n tktest\n-s concat a b c\n"
	update
    } {}
}

winfo interps
tk appname tktest
catch {destroy .f}
frame .f
set id [string range [winfo id .f] 2 end]
if $gotTestCmds {
    test send-12.1 {TimeoutProc procedure} {
        testsend prop root InterpRegistry "$id dummy\n"
        list [catch {send dummy foo} msg] $msg
    } {1 {target application died or uses a Tk version before 4.0}}
    testsend prop root InterpRegistry ""
}
test send-12.2 {TimeoutProc procedure} {
    winfo interps
    tk appname tktest
    update
    setupbg
    puts $fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
    set bgDone 0
    set bgData {}
    flush $fd
    tkwait variable bgDone
    set app $bgData
    after 200
    set result [list [catch {send $app foo} msg] $msg]
    close $fd
    set result
} {1 {target application died}}

winfo interps
tk appname tktest
test send-13.1 {DeleteProc procedure} {
    setupbg
    set app [dobg {rename send {}; tk appname}]
    set result [list [catch {send $app foo} msg] $msg [winfo interps]]
    cleanupbg
    set result
} {1 {no application named "tktest #2"} tktest}
test send-13.2 {DeleteProc procedure} {
    winfo interps
    tk appname tktest
    rename send {}
    set result {}
    lappend result [winfo interps] [info commands send]
    tk appname foo
    lappend result [winfo interps] [info commands send]
} {{} {} foo send}

if [info exists env(TK_ALT_DISPLAY)] {
    test send-14.1 {SendRestrictProc procedure, sends crossing from different displays} {
	setupbg -display $env(TK_ALT_DISPLAY)
	set result [dobg "
	    toplevel .t -screen [winfo screen .]
	    wm geometry .t +0+0
	    tk appname xyzgorp1
	    set x child
	"]
	toplevel .t -screen $env(TK_ALT_DISPLAY)
	wm geometry .t +0+0
	tk appname xyzgorp2
	update
	set y parent
	set result [send -displayof .t xyzgorp1 {list $x [send -displayof .t xyzgorp2 set y]}]
	destroy .t
	cleanupbg
	set result
    } {child parent}
}

if $gotTestCmds {
    testsend prop root InterpRegister $registry
    tk appname tktest
    test send-15.1 {UpdateCommWindow procedure} {
	set x [list [testsend prop comm TK_APPLICATION]]
	newApp "" t_s_1 Test
	send t_s_1 wm withdraw .
	newApp "" t_s_2 Test
	send t_s_2 wm withdraw .
	lappend x [testsend prop comm TK_APPLICATION]
	interp delete t_s_1
	lappend x [testsend prop comm TK_APPLICATION]
	interp delete t_s_2
	lappend x [testsend prop comm TK_APPLICATION]
    } {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest}
}

tk appname $name
if $gotTestCmds {
    testsend prop root InterpRegistry $registry
}
if $gotTestCmds {
    testdeleteapps
}
rename newApp {}