Tk Source Code

} {1 {target application died or uses a Tk version before 4.0}}
test send-5.4 {ValidateName procedure} {secureserver testsend} {
    tk appname test
    testsend prop root InterpRegistry "$commId Bogus\n$commId test\n"
    winfo interps
} {test}

if {[testConstraint nonPortable] && [testConstraint xhost] && [testConstraint aqua]} {
    winfo interps
    tk appname tktest
    update
    childTkProcess create
    set x [split [exec xhost] \n]
    foreach i [lrange $x 1 end]  {
	exec xhost - $i
    }
}

test send-6.1 {ServerSecure procedure} {nonPortable secureserver notAqua} {
    set a 44
    list [childTkProcess eval [list send [tk appname] set a 55]] $a
} {55 55}
test send-6.2 {ServerSecure procedure} {nonPortable secureserver xhost notAqua} {
    set a 22
    exec xhost [exec hostname]
    list [catch {childTkProcess eval [list send [tk appname] set a 33]} msg] $a $msg
} {0 22 {X server insecure (must use xauth-style authorization); command ignored}}
test send-6.3 {ServerSecure procedure} {nonPortable secureserver xhost notAqua} {
    set a abc
    exec xhost - [exec hostname]
    list [childTkProcess eval [list send [tk appname] set a new]] $a
} {new new}
childTkProcess exit

test send-7.1 {Tk_SetAppName procedure} {secureserver testsend} {

    send -async $app [list send [tk appname] set a 77]
    set result $a
    after 200 set x 40
    tkwait variable x
    childTkProcess exit
    lappend result $a
} {66 77}
test send-8.2 {Tk_SendCmd procedure, options} {secureserver altDisplay notAqua} {
    childTkProcess create -display $env(TK_ALT_DISPLAY)
    tk appname xyzgorp
    set a homeDisplay
    set result [childTkProcess eval "
    toplevel .t -screen [winfo screen .]
    wm geometry .t +0+0
    set a altDisplay

    winfo interps
    tk appname tktest
    set result
} {1 {no application named "bogus"}}

catch {interp delete t_s_1}

test send-8.17 {Tk_SendCmd procedure, deferring events} {secureserver nonPortable notAqua} {
    # 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.

    childTkProcess create
    set app [childTkProcess eval {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
    childTkProcess exit
    lappend result $a
} {{no event yet} {no event yet} exposed}
test send-8.18 {Tk_SendCmd procedure, error in remote app} {secureserver notAqua} {
    childTkProcess create
    set app [childTkProcess eval {tk appname}]
    set result [string tolower [list [catch {send $app open bad_name} msg] \
	    $msg $errorInfo $errorCode]]
    childTkProcess exit
    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} {secureserver notAqua} {
    childTkProcess create
    set app [childTkProcess eval {tk appname}]
    set x no
    set result ""
    after 0 {set x yes}
    lappend result [send $app {concat x y z}]
    lappend result $x

test send-10.17 {SendEventProc procedure, errorCode and errorInfo} {secureserver testsend} {
    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} {secureserver testsend notAqua} {
    childTkProcess create
    childTkProcess eval {tk appname t_s_3}
    set x [list [catch {send t_s_3 destroy .} msg] $msg]
    childTkProcess exit
    set x
} {0 {}}
test send-10.19 {SendEventProc procedure, send exits} {secureserver testsend notAqua} {
    childTkProcess create
    childTkProcess eval {tk appname t_s_3}
    set x [list [catch {send t_s_3 exit} msg] $msg]
    childTkProcess exit
    set x
} {1 {target application died}}

    rename send {}
    set result {}
    lappend result [winfo interps] [info commands send]
    tk appname foo
    lappend result [winfo interps] [info commands send]
} {{} {} foo send}

test send-14.1 {SendRestrictProc procedure, sends crossing from different displays} {secureserver altDisplay notAqua} {
    childTkProcess create -display $env(TK_ALT_DISPLAY)
    set result [childTkProcess eval "
    toplevel .t -screen [winfo screen .]
    wm geometry .t +0+0
    tk appname xyzgorp1
    set x child
    "]