tk/tests/send.test

   1 # This file is a Tcl script to test out the "send" command and the
   2 # other procedures in the file tkSend.c.  It is organized in the
   3 # standard fashion for Tcl tests.
   4 #
   5 # Copyright (c) 1994 Sun Microsystems, Inc.
   6 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
   7 # Copyright (c) 1998-1999 by Scriptics Corporation.
   8 # Copyright (c) 2001 by ActiveState Corporation.
   9 #
  10 # See the file "license.terms" for information on usage and redistribution
  11 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12 #
  13 # RCS: @(#) $Id$
  14
  15 package require tcltest 2.1
  16 namespace import -force tcltest::configure
  17 namespace import -force tcltest::testsDirectory
  18 configure -testdir [file join [pwd] [file dirname [info script]]]
  19 configure -loadfile [file join [testsDirectory] constraints.tcl]
  20 tcltest::loadTestedCommands
  21
  22 testConstraint xhost [llength [auto_execok xhost]]
  23 testConstraint testsend [llength [info commands testsend]]
  24
  25 # Compute a script that will load Tk into a child interpreter.
  26
  27 foreach pkg [info loaded] {
  28     if {[lindex $pkg 1] == "Tk"} {
  29         set loadTk "load $pkg"
  30         break
  31     }
  32 }
  33
  34 # Procedure to create a new application with a given name and class.
  35
  36 proc newApp {screen name class} {
  37     global loadTk
  38     interp create $name
  39     $name eval [list set argv [list -display $screen -name $name -class $class]]
  40     eval $loadTk $name
  41 }
  42
  43 set name [tk appname]
  44 set commId ""
  45 catch {
  46     set registry [testsend prop root InterpRegistry]
  47     set commId [lindex [testsend prop root InterpRegistry] 0]
  48 }
  49 tk appname tktest
  50 catch {send t_s_1 destroy .}
  51 catch {send t_s_2 destroy .}
  52
  53 test send-1.1 {RegOpen procedure, bogus property} {secureserver testsend} {
  54     testsend bogus
  55     set result [winfo interps]
  56     tk appname tktest
  57     list $result [winfo interps]
  58 } {{} tktest}
  59 test send-1.2 {RegOpen procedure, bogus property} {secureserver testsend} {
  60     testsend prop root InterpRegistry {}
  61     set result [winfo interps]
  62     tk appname tktest
  63     list $result [winfo interps]
  64 } {{} tktest}
  65 test send-1.3 {RegOpen procedure, bogus property} {secureserver testsend} {
  66     testsend prop root InterpRegistry abcdefg
  67     tk appname tktest
  68     set x [testsend prop root InterpRegistry]
  69     string range $x [string first " " $x] end
  70 } " tktest\nabcdefg\n"
  71
  72 frame .f -width 1 -height 1
  73 set id [string range [winfo id .f] 2 end]
  74 test send-2.1 {RegFindName procedure} {secureserver testsend} {
  75     testsend prop root InterpRegistry {}
  76     list [catch {send foo bar} msg] $msg
  77 } {1 {no application named "foo"}}
  78 test send-2.2 {RegFindName procedure} {secureserver testsend} {
  79     testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n"
  80     tk appname foo
  81 } {foo #2}
  82 test send-2.3 {RegFindName procedure} {secureserver testsend} {
  83     testsend prop root InterpRegistry "gyz foo\n"
  84     tk appname foo
  85 } {foo}
  86 test send-2.4 {RegFindName procedure} {secureserver testsend} {
  87     testsend prop root InterpRegistry "${id}z foo\n"
  88     tk appname foo
  89 } {foo}
  90
  91 test send-3.1 {RegDeleteName procedure} {secureserver testsend} {
  92     tk appname tktest
  93     testsend prop root InterpRegistry "012345 gorp\n12345 foo\n12345 tktest"
  94     tk appname x
  95     set x [testsend prop root InterpRegistry]
  96     string range $x [string first " " $x] end
  97 } " x\n012345 gorp\n12345 foo\n"
  98 test send-3.2 {RegDeleteName procedure} {secureserver testsend} {
  99     tk appname tktest
 100     testsend prop root InterpRegistry "012345 gorp\n12345 tktest\n23456 tktest"
 101     tk appname x
 102     set x [testsend prop root InterpRegistry]
 103     string range $x [string first " " $x] end
 104 } " x\n012345 gorp\n23456 tktest\n"
 105 test send-3.3 {RegDeleteName procedure} {secureserver testsend} {
 106     tk appname tktest
 107     testsend prop root InterpRegistry "012345 tktest\n12345 bar\n23456 tktest"
 108     tk appname x
 109     set x [testsend prop root InterpRegistry]
 110     string range $x [string first " " $x] end
 111 } " x\n12345 bar\n23456 tktest\n"
 112 test send-3.4 {RegDeleteName procedure} {secureserver testsend} {
 113     tk appname tktest
 114     testsend prop root InterpRegistry "foo"
 115     tk appname x
 116     set x [testsend prop root InterpRegistry]
 117     string range $x [string first " " $x] end
 118 } " x\nfoo\n"
 119 test send-3.5 {RegDeleteName procedure} {secureserver testsend} {
 120     tk appname tktest
 121     testsend prop root InterpRegistry ""
 122     tk appname x
 123     set x [testsend prop root InterpRegistry]
 124     string range $x [string first " " $x] end
 125 } " x\n"
 126
 127 test send-4.1 {RegAddName procedure} {secureserver testsend} {
 128     testsend prop root InterpRegistry ""
 129     tk appname bar
 130     testsend prop root InterpRegistry
 131 } "$commId bar\n"
 132 test send-4.2 {RegAddName procedure} {secureserver testsend} {
 133     testsend prop root InterpRegistry "abc def"
 134     tk appname bar
 135     tk appname foo
 136     testsend prop root InterpRegistry
 137 } "$commId foo\nabc def\n"
 138
 139 # Previous checks should already cover the Regclose procedure.
 140
 141 test send-5.1 {ValidateName procedure} {secureserver testsend} {
 142     testsend prop root InterpRegistry "123 abc\n"
 143     winfo interps
 144 } {}
 145 test send-5.2 {ValidateName procedure} {secureserver testsend} {
 146     testsend prop root InterpRegistry "$id Hi there"
 147     winfo interps
 148 } {{Hi there}}
 149 test send-5.3 {ValidateName procedure} {secureserver testsend} {
 150     testsend prop root InterpRegistry "$id Bogus"
 151     list [catch {send Bogus set a 44} msg] $msg
 152 } {1 {target application died or uses a Tk version before 4.0}}
 153 test send-5.4 {ValidateName procedure} {secureserver testsend} {
 154     tk appname test
 155     testsend prop root InterpRegistry "$commId Bogus\n$commId test\n"
 156     winfo interps
 157 } {test}
 158
 159 if {[testConstraint xhost]} {
 160     winfo interps
 161     tk appname tktest
 162     update
 163     setupbg
 164     set x [split [exec xhost] \n]
 165     foreach i [lrange $x 1 end]  {
 166         exec xhost - $i
 167     }
 168 }
 169
 170 test send-6.1 {ServerSecure procedure} {nonPortable secureserver} {
 171     set a 44
 172     list [dobg [list send [tk appname] set a 55]] $a
 173 } {55 55}
 174 test send-6.2 {ServerSecure procedure} {nonPortable secureserver} {
 175     set a 22
 176     exec xhost [exec hostname]
 177     list [catch {dobg [list send [tk appname] set a 33]} msg] $a $msg
 178 } {0 22 {X server insecure (must use xauth-style authorization); command ignored}}
 179 test send-6.3 {ServerSecure procedure} {nonPortable secureserver} {
 180     set a abc
 181     exec xhost - [exec hostname]
 182     list [dobg [list send [tk appname] set a new]] $a
 183 } {new new}
 184 cleanupbg
 185
 186 test send-7.1 {Tk_SetAppName procedure} {secureserver testsend} {
 187     testsend prop root InterpRegistry ""
 188     tk appname newName
 189     list [tk appname oldName] [testsend prop root InterpRegistry]
 190 } "oldName {$commId oldName\n}"
 191 test send-7.2 {Tk_SetAppName procedure, name not in use} {secureserver testsend} {
 192     testsend prop root InterpRegistry ""
 193     list [tk appname gorp] [testsend prop root InterpRegistry]
 194 } "gorp {$commId gorp\n}"
 195 test send-7.3 {Tk_SetAppName procedure, name in use by us} {secureserver testsend} {
 196     tk appname name1
 197     testsend prop root InterpRegistry "$commId name2\n"
 198     list [tk appname name2] [testsend prop root InterpRegistry]
 199 } "name2 {$commId name2\n}"
 200 test send-7.4 {Tk_SetAppName procedure, name in use} {secureserver testsend} {
 201     tk appname name1
 202     testsend prop root InterpRegistry "$id foo\n$id foo #2\n$id foo #3\n"
 203     list [tk appname foo] [testsend prop root InterpRegistry]
 204 } "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}"
 205
 206 test send-8.1 {Tk_SendCmd procedure, options} {secureserver} {
 207     setupbg
 208     set app [dobg {tk appname}]
 209     set a 66
 210     send -async $app [list send [tk appname] set a 77]
 211     set result $a
 212     after 200 set x 40
 213     tkwait variable x
 214     cleanupbg
 215     lappend result $a
 216 } {66 77}
 217 test send-8.2 {Tk_SendCmd procedure, options} {secureserver altDisplay} {
 218     setupbg -display $env(TK_ALT_DISPLAY)
 219     tk appname xyzgorp
 220     set a homeDisplay
 221     set result [dobg "
 222     toplevel .t -screen [winfo screen .]
 223     wm geometry .t +0+0
 224     set a altDisplay
 225     tk appname xyzgorp
 226     list \[send xyzgorp set a\] \[send -displayof .t xyzgorp set a\]
 227     "]
 228     cleanupbg
 229     set result
 230 } {altDisplay homeDisplay}
 231 test send-8.3 {Tk_SendCmd procedure, options} {secureserver} {
 232     list [catch {send -- -async foo bar baz} msg] $msg
 233 } {1 {no application named "-async"}}
 234 test send-8.4 {Tk_SendCmd procedure, options} {secureserver} {
 235     list [catch {send -gorp foo bar baz} msg] $msg
 236 } {1 {bad option "-gorp": must be -async, -displayof, or --}}
 237 test send-8.5 {Tk_SendCmd procedure, options} {secureserver} {
 238     list [catch {send -async foo} msg] $msg
 239 } {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
 240 test send-8.6 {Tk_SendCmd procedure, options} {secureserver} {
 241     list [catch {send foo} msg] $msg
 242 } {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
 243 test send-8.7 {Tk_SendCmd procedure, local execution} {secureserver} {
 244     set a initial
 245     send [tk appname] {set a new}
 246     set a
 247 } {new}
 248 test send-8.8 {Tk_SendCmd procedure, local execution} {secureserver} {
 249     set a initial
 250     send [tk appname] set a new
 251     set a
 252 } {new}
 253 test send-8.9 {Tk_SendCmd procedure, local execution} {secureserver} {
 254     set a initial
 255     string tolower [list [catch {send [tk appname] open bad_file} msg] \
 256             $msg $errorInfo $errorCode]
 257 } {1 {couldn't open "bad_file": no such file or directory} {couldn't open "bad_file": no such file or directory
 258     while executing
 259 "open bad_file"
 260     invoked from within
 261 "send [tk appname] open bad_file"} {posix enoent {no such file or directory}}}
 262 test send-8.10 {Tk_SendCmd procedure, no such interpreter} {secureserver} {
 263     list [catch {send bogus_name bogus_command} msg] $msg
 264 } {1 {no application named "bogus_name"}}
 265
 266 catch {
 267     newApp "" t_s_1 Test
 268     t_s_1 eval wm withdraw .
 269 }
 270
 271 test send-8.11 {Tk_SendCmd procedure, local execution, different interp} {secureserver testsend} {
 272     set a us
 273     send t_s_1 set a them
 274     list $a [send t_s_1 set a]
 275 } {us them}
 276 test send-8.12 {Tk_SendCmd procedure, local execution, different interp} {secureserver testsend} {
 277     set a us
 278     send t_s_1 {set a them}
 279     list $a [send t_s_1 {set a}]
 280 } {us them}
 281 test send-8.13 {Tk_SendCmd procedure, local execution, different interp} {secureserver testsend} {
 282     set a us
 283     send t_s_1 {set a them}
 284     list $a [send t_s_1 {set a}]
 285 } {us them}
 286 test send-8.14 {Tk_SendCmd procedure, local interp killed by send} {secureserver testsend} {
 287     newApp "" t_s_2 Test
 288     list [catch {send t_s_2 {destroy .; concat result}} msg] $msg
 289 } {0 result}
 290
 291 catch {interp delete t_s_2}
 292
 293 test send-8.15 {Tk_SendCmd procedure, local interp, error info} {secureserver testsend} {
 294     catch {error foo}
 295     list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
 296 } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory
 297     while executing
 298 "open bogus_file_name"
 299     invoked from within
 300 "if 1 {open bogus_file_name}"
 301     invoked from within
 302 "send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
 303 test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend} {
 304     testsend prop root InterpRegistry "10234 bogus\n"
 305     set result [list [catch {send bogus bogus command} msg] $msg]
 306     winfo interps
 307     tk appname tktest
 308     set result
 309 } {1 {no application named "bogus"}}
 310
 311 catch {interp delete t_s_1}
 312
 313 test send-8.17 {Tk_SendCmd procedure, deferring events} {secureserver nonPortable} {
 314     # Non-portable because some window managers ignore "raise"
 315     # requests so can't guarantee that new app's window won't
 316     # obscure .f, thereby masking the Expose event.
 317
 318     setupbg
 319     set app [dobg {tk appname}]
 320     raise .             ; # Don't want new app obscuring .f
 321     catch {destroy .f}
 322     frame .f
 323     place .f -x 0 -y 0
 324     bind .f <Expose> {set a exposed}
 325     set a {no event yet}
 326     set result ""
 327     lappend result [send $app send [list [tk appname]] set a]
 328     lappend result $a
 329     update
 330     cleanupbg
 331     lappend result $a
 332 } {{no event yet} {no event yet} exposed}
 333 test send-8.18 {Tk_SendCmd procedure, error in remote app} {secureserver} {
 334     setupbg
 335     set app [dobg {tk appname}]
 336     set result [string tolower [list [catch {send $app open bad_name} msg] \
 337             $msg $errorInfo $errorCode]]
 338     cleanupbg
 339     set result
 340 } {1 {couldn't open "bad_name": no such file or directory} {couldn't open "bad_name": no such file or directory
 341     while executing
 342 "open bad_name"
 343     invoked from within
 344 "send $app open bad_name"} {posix enoent {no such file or directory}}}
 345 test send-8.19 {Tk_SendCmd, using modal timeouts} {secureserver} {
 346     setupbg
 347     set app [dobg {tk appname}]
 348     set x no
 349     set result ""
 350     after 0 {set x yes}
 351     lappend result [send $app {concat x y z}]
 352     lappend result $x
 353     update
 354     cleanupbg
 355     lappend result $x
 356 } {{x y z} no yes}
 357
 358 tk appname tktest
 359 catch {destroy .f}
 360 frame .f
 361 set id [string range [winfo id .f] 2 end]
 362
 363 test send-9.1 {Tk_GetInterpNames procedure} {secureserver testsend} {
 364     testsend prop root InterpRegistry \
 365             "$commId tktest\nfoo bar\n$commId tktest\n$id frame .f\n\n\n"
 366     list [winfo interps] [testsend prop root InterpRegistry]
 367 } "{tktest tktest {frame .f}} {$commId tktest\n$commId tktest\n$id frame .f
 368 }"
 369 test send-9.2 {Tk_GetInterpNames procedure} {secureserver testsend} {
 370     testsend prop root InterpRegistry \
 371             "$commId tktest\nfoobar\n$commId gorp\n"
 372     list [winfo interps] [testsend prop root InterpRegistry]
 373 } "tktest {$commId tktest\n}"
 374 test send-9.3 {Tk_GetInterpNames procedure} {secureserver testsend} {
 375     testsend prop root InterpRegistry {}
 376     list [winfo interps] [testsend prop root InterpRegistry]
 377 } {{} {}}
 378
 379 catch {testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"}
 380
 381 test send-10.1 {SendEventProc procedure, bogus comm property} {secureserver testsend} {
 382     testsend prop comm Comm {abc def}
 383     testsend prop comm Comm {}
 384     update
 385 } {}
 386 test send-10.2 {SendEventProc procedure, simultaneous messages} {secureserver testsend} {
 387     testsend prop comm Comm \
 388             "c\n-n tktest\n-s set a 44\nc\n-n tktest\n-s set b 45\n"
 389     set a null
 390     set b xyzzy
 391     update
 392     list $a $b
 393 } {44 45}
 394 test send-10.3 {SendEventProc procedure, simultaneous messages} {secureserver testsend} {
 395     testsend prop comm Comm \
 396             "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"
 397     set a null
 398     set b xyzzy
 399     set x [send dummy bogus]
 400     list $x $a $b
 401 } {12345 newA newB}
 402 test send-10.4 {SendEventProc procedure, leading nulls, bogus commands} {secureserver testsend} {
 403     testsend prop comm Comm \
 404             "\n\nx\n-bogus\n\nc\n-n tktest\n-s set a 44\n"
 405     set a null
 406     update
 407     set a
 408 } {44}
 409 test send-10.5 {SendEventProc procedure, extraneous command options} {secureserver testsend} {
 410     testsend prop comm Comm \
 411             "c\n-n tktest\n-x miscellanous\n-y who knows?\n-s set a new\n"
 412     set a null
 413     update
 414     set a
 415 } {new}
 416 test send-10.6 {SendEventProc procedure, unknown interpreter} {secureserver testsend} {
 417     testsend prop [winfo id .f] Comm {}
 418     testsend prop comm Comm \
 419             "c\n-n unknown\n-r $id 44\n-s set a new\n"
 420     set a null
 421     update
 422     list [testsend prop [winfo id .f] Comm] $a
 423 } "{\nr\n-s 44\n-r receiver never heard of interpreter \"unknown\"\n-c 1\n} null"
 424 test send-10.7 {SendEventProc procedure, error in script} {secureserver testsend} {
 425     testsend prop [winfo id .f] Comm {}
 426     testsend prop comm Comm \
 427             "c\n-n tktest\n-r $id 62\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
 428     update
 429     testsend prop [winfo id .f] Comm
 430 } {
 431 r
 432 -s 62
 433 -r test error
 434 -i Initial errorInfo
 435     ("foreach" body line 1)
 436     invoked from within
 437 "foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}"
 438 -e test code
 439 -c 1
 440 }
 441 test send-10.8 {SendEventProc procedure, exceptional return} {secureserver testsend} {
 442     testsend prop [winfo id .f] Comm {}
 443     testsend prop comm Comm \
 444             "c\n-n tktest\n-r $id 62\n-s break\n"
 445     update
 446     testsend prop [winfo id .f] Comm
 447 } {
 448 r
 449 -s 62
 450 -r
 451 -c 3
 452 }
 453 test send-10.9 {SendEventProc procedure, empty return} {secureserver testsend} {
 454     testsend prop [winfo id .f] Comm {}
 455     testsend prop comm Comm \
 456             "c\n-n tktest\n-r $id 62\n-s concat\n"
 457     update
 458     testsend prop [winfo id .f] Comm
 459 } {
 460 r
 461 -s 62
 462 -r
 463 }
 464 test send-10.10 {SendEventProc procedure, asynchronous calls} {secureserver testsend} {
 465     testsend prop [winfo id .f] Comm {}
 466     testsend prop comm Comm \
 467             "c\n-n tktest\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
 468     update
 469     testsend prop [winfo id .f] Comm
 470 } {}
 471 test send-10.11 {SendEventProc procedure, exceptional return} {secureserver testsend} {
 472     testsend prop [winfo id .f] Comm {}
 473     testsend prop comm Comm \
 474             "c\n-n tktest\n-s break\n"
 475     update
 476     testsend prop [winfo id .f] Comm
 477 } {}
 478 test send-10.12 {SendEventProc procedure, empty return} {secureserver testsend} {
 479     testsend prop [winfo id .f] Comm {}
 480     testsend prop comm Comm \
 481             "c\n-n tktest\n-s concat\n"
 482     update
 483     testsend prop [winfo id .f] Comm
 484 } {}
 485 test send-10.13 {SendEventProc procedure, return processing} {secureserver testsend} {
 486     testsend prop comm Comm \
 487             "r\n-c 1\n-e test1\n-i test2\n-r test3\n-s [testsend serial]\n"
 488     list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
 489 } {1 test3 {test2
 490     invoked from within
 491 "send dummy foo"} test1}
 492 test send-10.14 {SendEventProc procedure, extraneous return options} {secureserver testsend} {
 493     testsend prop comm Comm \
 494             "r\n-x test1\n-y test2\n-r result\n-s [testsend serial]\n"
 495     list [catch {send dummy foo} msg] $msg
 496 } {0 result}
 497 test send-10.15 {SendEventProc procedure, serial number} {secureserver testsend} {
 498     testsend prop comm Comm \
 499             "r\n-r response\n"
 500     list [catch {send dummy foo} msg] $msg
 501 } {1 {target application died or uses a Tk version before 4.0}}
 502 test send-10.16 {SendEventProc procedure, serial number} {secureserver testsend} {
 503     testsend prop comm Comm \
 504             "r\n-r response\n\n-s 0"
 505     list [catch {send dummy foo} msg] $msg
 506 } {1 {target application died or uses a Tk version before 4.0}}
 507 test send-10.17 {SendEventProc procedure, errorCode and errorInfo} {secureserver testsend} {
 508     testsend prop comm Comm \
 509             "r\n-i test1\n-e test2\n-c 4\n-s [testsend serial]\n"
 510     set errorCode oldErrorCode
 511     set errorInfo oldErrorInfo
 512     list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
 513 } {4 {} oldErrorInfo oldErrorCode}
 514 test send-10.18 {SendEventProc procedure, send kills application} {secureserver testsend} {
 515     setupbg
 516     dobg {tk appname t_s_3}
 517     set x [list [catch {send t_s_3 destroy .} msg] $msg]
 518     cleanupbg
 519     set x
 520 } {0 {}}
 521 test send-10.19 {SendEventProc procedure, send exits} {secureserver testsend} {
 522     setupbg
 523     dobg {tk appname t_s_3}
 524     set x [list [catch {send t_s_3 exit} msg] $msg]
 525     cleanupbg
 526     set x
 527 } {1 {target application died}}
 528
 529 test send-11.1 {AppendPropCarefully and AppendErrorProc procedures} {secureserver testsend} {
 530     testsend prop root InterpRegistry "0x21447 dummy\n"
 531     list [catch {send dummy foo} msg] $msg
 532 } {1 {no application named "dummy"}}
 533 test send-11.2 {AppendPropCarefully and AppendErrorProc procedures} {secureserver testsend} {
 534     testsend prop comm Comm "c\n-r0x123 44\n-n tktest\n-s concat a b c\n"
 535     update
 536 } {}
 537
 538 winfo interps
 539 tk appname tktest
 540 catch {destroy .f}
 541 frame .f
 542 set id [string range [winfo id .f] 2 end]
 543
 544 test send-12.1 {TimeoutProc procedure} {secureserver testsend} {
 545     testsend prop root InterpRegistry "$id dummy\n"
 546     list [catch {send dummy foo} msg] $msg
 547 } {1 {target application died or uses a Tk version before 4.0}}
 548
 549 catch {testsend prop root InterpRegistry ""}
 550
 551 test send-12.2 {TimeoutProc procedure} {secureserver} {
 552     winfo interps
 553     tk appname tktest
 554     update
 555     setupbg
 556     set app [dobg {
 557         after 10 {after 10 {after 5000; exit}}
 558         tk appname
 559     }]
 560     after 200
 561     set result [list [catch {send $app foo} msg] $msg]
 562     cleanupbg
 563     set result
 564 } {1 {target application died}}
 565
 566 winfo interps
 567 tk appname tktest
 568 test send-13.1 {DeleteProc procedure} {secureserver} {
 569     setupbg
 570     set app [dobg {rename send {}; tk appname}]
 571     set result [list [catch {send $app foo} msg] $msg [winfo interps]]
 572     cleanupbg
 573     set result
 574 } {1 {no application named "tktest #2"} tktest}
 575 test send-13.2 {DeleteProc procedure} {secureserver} {
 576     winfo interps
 577     tk appname tktest
 578     rename send {}
 579     set result {}
 580     lappend result [winfo interps] [info commands send]
 581     tk appname foo
 582     lappend result [winfo interps] [info commands send]
 583 } {{} {} foo send}
 584
 585 test send-14.1 {SendRestrictProc procedure, sends crossing from different displays} {secureserver altDisplay} {
 586     setupbg -display $env(TK_ALT_DISPLAY)
 587     set result [dobg "
 588     toplevel .t -screen [winfo screen .]
 589     wm geometry .t +0+0
 590     tk appname xyzgorp1
 591     set x child
 592     "]
 593     toplevel .t -screen $env(TK_ALT_DISPLAY)
 594     wm geometry .t +0+0
 595     tk appname xyzgorp2
 596     update
 597     set y parent
 598     set result [send -displayof .t xyzgorp1 {list $x [send -displayof .t xyzgorp2 set y]}]
 599     destroy .t
 600     cleanupbg
 601     set result
 602 } {child parent}
 603
 604 catch {
 605     testsend prop root InterpRegister $registry
 606     tk appname tktest
 607 }
 608 test send-15.1 {UpdateCommWindow procedure} {secureserver testsend} {
 609     set x [list [testsend prop comm TK_APPLICATION]]
 610     newApp "" t_s_1 Test
 611     send t_s_1 wm withdraw .
 612     newApp "" t_s_2 Test
 613     send t_s_2 wm withdraw .
 614     lappend x [testsend prop comm TK_APPLICATION]
 615     interp delete t_s_1
 616     lappend x [testsend prop comm TK_APPLICATION]
 617     interp delete t_s_2
 618     lappend x [testsend prop comm TK_APPLICATION]
 619 } {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest}
 620
 621 catch {
 622     tk appname $name
 623     testsend prop root InterpRegistry $registry
 624     testdeleteapps
 625 }
 626 rename newApp {}
 627
 628 # cleanup
 629 ::tcltest::cleanupTests
 630 return