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