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: send.test,v 1.8.2.1 2003/07/09 21:12:52 dkf Exp $ 14 15package require tcltest 2.1 16namespace import -force tcltest::configure 17namespace import -force tcltest::testsDirectory 18configure -testdir [file join [pwd] [file dirname [info script]]] 19configure -loadfile [file join [testsDirectory] constraints.tcl] 20tcltest::loadTestedCommands 21 22testConstraint xhost [llength [auto_execok xhost]] 23testConstraint testsend [llength [info commands testsend]] 24 25# Compute a script that will load Tk into a child interpreter. 26 27foreach 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 36proc 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 43set name [tk appname] 44set commId "" 45catch { 46 set registry [testsend prop root InterpRegistry] 47 set commId [lindex [testsend prop root InterpRegistry] 0] 48} 49tk appname tktest 50catch {send t_s_1 destroy .} 51catch {send t_s_2 destroy .} 52 53test 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} 59test 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} 65test 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 72frame .f -width 1 -height 1 73set id [string range [winfo id .f] 2 end] 74test 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"}} 78test 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} 82test send-2.3 {RegFindName procedure} {secureserver testsend} { 83 testsend prop root InterpRegistry "gyz foo\n" 84 tk appname foo 85} {foo} 86test send-2.4 {RegFindName procedure} {secureserver testsend} { 87 testsend prop root InterpRegistry "${id}z foo\n" 88 tk appname foo 89} {foo} 90 91test 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" 98test 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" 105test 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" 112test 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" 119test 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 127test 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" 132test 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 141test send-5.1 {ValidateName procedure} {secureserver testsend} { 142 testsend prop root InterpRegistry "123 abc\n" 143 winfo interps 144} {} 145test send-5.2 {ValidateName procedure} {secureserver testsend} { 146 testsend prop root InterpRegistry "$id Hi there" 147 winfo interps 148} {{Hi there}} 149test 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}} 153test 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 159if {[testConstraint nonPortable] && [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 170test 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} 174test send-6.2 {ServerSecure procedure} {nonPortable secureserver xhost} { 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}} 179test send-6.3 {ServerSecure procedure} {nonPortable secureserver xhost} { 180 set a abc 181 exec xhost - [exec hostname] 182 list [dobg [list send [tk appname] set a new]] $a 183} {new new} 184cleanupbg 185 186test 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}" 191test 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}" 195test 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}" 200test 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 206test 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} 217test 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} 231test send-8.3 {Tk_SendCmd procedure, options} {secureserver} { 232 list [catch {send -- -async foo bar baz} msg] $msg 233} {1 {no application named "-async"}} 234test 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 --}} 237test 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 ...?"}} 240test 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 ...?"}} 243test 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} 248test 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} 253test 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}}} 262test 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 266catch { 267 newApp "" t_s_1 Test 268 t_s_1 eval wm withdraw . 269} 270 271test 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} 276test 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} 281test 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} 286test 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 291catch {interp delete t_s_2} 292 293test 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}}} 303test 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 311catch {interp delete t_s_1} 312 313test 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} 333test 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}}} 345test 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 358tk appname tktest 359catch {destroy .f} 360frame .f 361set id [string range [winfo id .f] 2 end] 362 363test 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}" 369test 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}" 374test send-9.3 {Tk_GetInterpNames procedure} {secureserver testsend} { 375 testsend prop root InterpRegistry {} 376 list [winfo interps] [testsend prop root InterpRegistry] 377} {{} {}} 378 379catch {testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"} 380 381test 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} {} 386test 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} 394test 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} 402test 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} 409test 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} 416test 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" 424test 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} { 431r 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} 441test 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} { 448r 449-s 62 450-r 451-c 3 452} 453test 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} { 460r 461-s 62 462-r 463} 464test 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} {} 471test 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} {} 478test 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} {} 485test 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} 492test 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} 497test 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}} 502test 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}} 507test 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} 514test 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 {}} 521test 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 529test 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"}} 533test 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 538winfo interps 539tk appname tktest 540catch {destroy .f} 541frame .f 542set id [string range [winfo id .f] 2 end] 543 544test 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 549catch {testsend prop root InterpRegistry ""} 550 551test 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 566winfo interps 567tk appname tktest 568test 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} 575test 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 585test 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 604catch { 605 testsend prop root InterpRegister $registry 606 tk appname tktest 607} 608test 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 621catch { 622 tk appname $name 623 testsend prop root InterpRegistry $registry 624 testdeleteapps 625} 626rename newApp {} 627 628# cleanup 629::tcltest::cleanupTests 630return 631