summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2001-08-30 01:51:13 (GMT)
committerhobbs <hobbs>2001-08-30 01:51:13 (GMT)
commit96adcf5aa5e6fac1276e40be17d81a0b366b4828 (patch)
tree8a712b8120741179a1f32039b3d69149dddfc45a
parente3a110a35f440dc46497f8855d741f173ed1caab (diff)
downloadtk-96adcf5aa5e6fac1276e40be17d81a0b366b4828.zip
tk-96adcf5aa5e6fac1276e40be17d81a0b366b4828.tar.gz
tk-96adcf5aa5e6fac1276e40be17d81a0b366b4828.tar.bz2
* tests/unixSend.test: removed test file completely identical to
send.test. Removed platform specific named file in case somebody gets send working on Win/Mac in the future.
-rw-r--r--tests/unixSend.test679
1 files changed, 0 insertions, 679 deletions
diff --git a/tests/unixSend.test b/tests/unixSend.test
deleted file mode 100644
index 5914dd7..0000000
--- a/tests/unixSend.test
+++ /dev/null
@@ -1,679 +0,0 @@
-# This file is a Tcl script to test out the "send" command and the
-# other procedures in the file tkSend.c. It is organized in the
-# standard fashion for Tcl tests.
-#
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-#
-# RCS: @(#) $Id: unixSend.test,v 1.2 1999/04/16 01:51:42 stanton Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
-
-if {$tcl_platform(platform) == "macintosh"} {
- puts "send is not available on the Mac - skipping tests"
- ::tcltest::cleanupTests
- return
-}
-if {$tcl_platform(platform) == "windows"} {
- puts "skipping: Unix only tests..."
- ::tcltest::cleanupTests
- return
-}
-if {[auto_execok xhost] == ""} {
- puts "xhost application isn't available - skipping tests"
- ::tcltest::cleanupTests
- return
-}
-
-if {[info commands testsend] == "testsend"} {
- set gotTestCmds 1
-} else {
- set gotTestCmds 0
-}
-
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
-
-# If send is disabled because of inadequate security, don't run any
-# of these tests at all.
-
-setupbg
-set app [dobg {tk appname}]
-if {[catch {send $app set a 0} msg] == 1} {
- if [string match "X server insecure *" $msg] {
- puts -nonewline "Your X server is insecure, so \"send\" can't be used;"
- puts " skipping \"send\" tests."
- cleanupbg
- ::tcltest::cleanupTests
- return
- }
-}
-cleanupbg
-
-# Compute a script that will load Tk into a child interpreter.
-
-foreach pkg [info loaded] {
- if {[lindex $pkg 1] == "Tk"} {
- set loadTk "load $pkg"
- break
- }
-}
-
-# Procedure to create a new application with a given name and class.
-
-proc newApp {screen name class} {
- global loadTk
- interp create $name
- $name eval [list set argv [list -display $screen -name $name -class $class]]
- eval $loadTk $name
-}
-
-set name [tk appname]
-if $gotTestCmds {
- set registry [testsend prop root InterpRegistry]
- set commId [lindex [testsend prop root InterpRegistry] 0]
-}
-tk appname tktest
-catch {send t_s_1 destroy .}
-catch {send t_s_2 destroy .}
-
-if $gotTestCmds {
- test unixSend-1.1 {RegOpen procedure, bogus property} {
- testsend bogus
- set result [winfo interps]
- tk appname tktest
- list $result [winfo interps]
- } {{} tktest}
- test unixSend-1.2 {RegOpen procedure, bogus property} {
- testsend prop root InterpRegistry {}
- set result [winfo interps]
- tk appname tktest
- list $result [winfo interps]
- } {{} tktest}
- test unixSend-1.3 {RegOpen procedure, bogus property} {
- testsend prop root InterpRegistry abcdefg
- tk appname tktest
- set x [testsend prop root InterpRegistry]
- string range $x [string first " " $x] end
- } " tktest\nabcdefg\n"
-
- frame .f -width 1 -height 1
- set id [string range [winfo id .f] 2 end]
- test unixSend-2.1 {RegFindName procedure} {
- testsend prop root InterpRegistry {}
- list [catch {send foo bar} msg] $msg
- } {1 {no application named "foo"}}
- test unixSend-2.2 {RegFindName procedure} {
- testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n"
- tk appname foo
- } {foo #2}
- test unixSend-2.3 {RegFindName procedure} {
- testsend prop root InterpRegistry "gyz foo\n"
- tk appname foo
- } {foo}
- test unixSend-2.4 {RegFindName procedure} {
- testsend prop root InterpRegistry "${id}z foo\n"
- tk appname foo
- } {foo}
-
- test unixSend-3.1 {RegDeleteName procedure} {
- tk appname tktest
- testsend prop root InterpRegistry "012345 gorp\n12345 foo\n12345 tktest"
- tk appname x
- set x [testsend prop root InterpRegistry]
- string range $x [string first " " $x] end
- } " x\n012345 gorp\n12345 foo\n"
- test unixSend-3.2 {RegDeleteName procedure} {
- tk appname tktest
- testsend prop root InterpRegistry "012345 gorp\n12345 tktest\n23456 tktest"
- tk appname x
- set x [testsend prop root InterpRegistry]
- string range $x [string first " " $x] end
- } " x\n012345 gorp\n23456 tktest\n"
- test unixSend-3.3 {RegDeleteName procedure} {
- tk appname tktest
- testsend prop root InterpRegistry "012345 tktest\n12345 bar\n23456 tktest"
- tk appname x
- set x [testsend prop root InterpRegistry]
- string range $x [string first " " $x] end
- } " x\n12345 bar\n23456 tktest\n"
- test unixSend-3.4 {RegDeleteName procedure} {
- tk appname tktest
- testsend prop root InterpRegistry "foo"
- tk appname x
- set x [testsend prop root InterpRegistry]
- string range $x [string first " " $x] end
- } " x\nfoo\n"
- test unixSend-3.5 {RegDeleteName procedure} {
- tk appname tktest
- testsend prop root InterpRegistry ""
- tk appname x
- set x [testsend prop root InterpRegistry]
- string range $x [string first " " $x] end
- } " x\n"
-
- test unixSend-4.1 {RegAddName procedure} {
- testsend prop root InterpRegistry ""
- tk appname bar
- testsend prop root InterpRegistry
- } "$commId bar\n"
- test unixSend-4.2 {RegAddName procedure} {
- testsend prop root InterpRegistry "abc def"
- tk appname bar
- tk appname foo
- testsend prop root InterpRegistry
- } "$commId foo\nabc def\n"
-
- # Previous checks should already cover the Regclose procedure.
-
- test unixSend-5.1 {ValidateName procedure} {
- testsend prop root InterpRegistry "123 abc\n"
- winfo interps
- } {}
- test unixSend-5.2 {ValidateName procedure} {
- testsend prop root InterpRegistry "$id Hi there"
- winfo interps
- } {{Hi there}}
- test unixSend-5.3 {ValidateName procedure} {
- testsend prop root InterpRegistry "$id Bogus"
- list [catch {send Bogus set a 44} msg] $msg
- } {1 {target application died or uses a Tk version before 4.0}}
- test unixSend-5.4 {ValidateName procedure} {
- tk appname test
- testsend prop root InterpRegistry "$commId Bogus\n$commId test\n"
- winfo interps
- } {test}
-}
-
-winfo interps
-tk appname tktest
-update
-setupbg
-set x [split [exec xhost] \n]
-foreach i [lrange $x 1 end] {
- exec xhost - $i
-}
-test unixSend-6.1 {ServerSecure procedure} {nonPortable} {
- set a 44
- list [dobg [list send [tk appname] set a 55]] $a
-} {55 55}
-test unixSend-6.2 {ServerSecure procedure} {nonPortable} {
- set a 22
- exec xhost [exec hostname]
- list [catch {dobg [list send [tk appname] set a 33]} msg] $a $msg
-} {0 22 {X server insecure (must use xauth-style authorization); command ignored}}
-test unixSend-6.3 {ServerSecure procedure} {nonPortable} {
- set a abc
- exec xhost - [exec hostname]
- list [dobg [list send [tk appname] set a new]] $a
-} {new new}
-cleanupbg
-
-if $gotTestCmds {
- test unixSend-7.1 {Tk_SetAppName procedure} {
- testsend prop root InterpRegistry ""
- tk appname newName
- list [tk appname oldName] [testsend prop root InterpRegistry]
- } "oldName {$commId oldName\n}"
- test unixSend-7.2 {Tk_SetAppName procedure, name not in use} {
- testsend prop root InterpRegistry ""
- list [tk appname gorp] [testsend prop root InterpRegistry]
- } "gorp {$commId gorp\n}"
- test unixSend-7.3 {Tk_SetAppName procedure, name in use by us} {
- tk appname name1
- testsend prop root InterpRegistry "$commId name2\n"
- list [tk appname name2] [testsend prop root InterpRegistry]
- } "name2 {$commId name2\n}"
- test unixSend-7.4 {Tk_SetAppName procedure, name in use} {
- tk appname name1
- testsend prop root InterpRegistry "$id foo\n$id foo #2\n$id foo #3\n"
- list [tk appname foo] [testsend prop root InterpRegistry]
- } "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}"
-}
-
-test unixSend-8.1 {Tk_SendCmd procedure, options} {
- setupbg
- set app [dobg {tk appname}]
- set a 66
- send -async $app [list send [tk appname] set a 77]
- set result $a
- after 200 set x 40
- tkwait variable x
- cleanupbg
- lappend result $a
-} {66 77}
-if [info exists env(TK_ALT_DISPLAY)] {
- test unixSend-8.2 {Tk_SendCmd procedure, options} {
- setupbg -display $env(TK_ALT_DISPLAY)
- tk appname xyzgorp
- set a homeDisplay
- set result [dobg "
- toplevel .t -screen [winfo screen .]
- wm geometry .t +0+0
- set a altDisplay
- tk appname xyzgorp
- list \[send xyzgorp set a\] \[send -displayof .t xyzgorp set a\]
- "]
- cleanupbg
- set result
- } {altDisplay homeDisplay}
-}
-test unixSend-8.3 {Tk_SendCmd procedure, options} {
- list [catch {send -- -async foo bar baz} msg] $msg
-} {1 {no application named "-async"}}
-test unixSend-8.4 {Tk_SendCmd procedure, options} {
- list [catch {send -gorp foo bar baz} msg] $msg
-} {1 {bad option "-gorp": must be -async, -displayof, or --}}
-test unixSend-8.5 {Tk_SendCmd procedure, options} {
- list [catch {send -async foo} msg] $msg
-} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
-test unixSend-8.6 {Tk_SendCmd procedure, options} {
- list [catch {send foo} msg] $msg
-} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
-test unixSend-8.7 {Tk_SendCmd procedure, local execution} {
- set a initial
- send [tk appname] {set a new}
- set a
-} {new}
-test unixSend-8.8 {Tk_SendCmd procedure, local execution} {
- set a initial
- send [tk appname] set a new
- set a
-} {new}
-test unixSend-8.9 {Tk_SendCmd procedure, local execution} {
- set a initial
- string tolower [list [catch {send [tk appname] open bad_file} msg] \
- $msg $errorInfo $errorCode]
-} {1 {couldn't open "bad_file": no such file or directory} {couldn't open "bad_file": no such file or directory
- while executing
-"open bad_file"
- invoked from within
-"send [tk appname] open bad_file"} {posix enoent {no such file or directory}}}
-test unixSend-8.10 {Tk_SendCmd procedure, no such interpreter} {
- list [catch {send bogus_name bogus_command} msg] $msg
-} {1 {no application named "bogus_name"}}
-if $gotTestCmds {
- newApp "" t_s_1 Test
- t_s_1 eval wm withdraw .
- test unixSend-8.11 {Tk_SendCmd procedure, local execution, different interp} {
- set a us
- send t_s_1 set a them
- list $a [send t_s_1 set a]
- } {us them}
- test unixSend-8.12 {Tk_SendCmd procedure, local execution, different interp} {
- set a us
- send t_s_1 {set a them}
- list $a [send t_s_1 {set a}]
- } {us them}
- test unixSend-8.13 {Tk_SendCmd procedure, local execution, different interp} {
- set a us
- send t_s_1 {set a them}
- list $a [send t_s_1 {set a}]
- } {us them}
- test unixSend-8.14 {Tk_SendCmd procedure, local interp killed by send} {
- newApp "" t_s_2 Test
- list [catch {send t_s_2 {destroy .; concat result}} msg] $msg
- } {0 result}
- interp delete t_s_2
- test unixSend-8.15 {Tk_SendCmd procedure, local interp, error info} {
- catch {error foo}
- list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
- } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory
- while executing
-"open bogus_file_name"
- invoked from within
-"if 1 {open bogus_file_name}"
- invoked from within
-"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
- test unixSend-8.16 {Tk_SendCmd procedure, bogusCommWindow} {
- 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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-10.1 {SendEventProc procedure, bogus comm property} {
- testsend prop comm Comm {abc def}
- testsend prop comm Comm {}
- update
- } {}
- test unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 unixSend-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 $::tcltest::fd
- set x
- } {1 {target application died}}
-
- test unixSend-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 unixSend-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 unixSend-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 unixSend-12.2 {TimeoutProc procedure} {
- winfo interps
- tk appname tktest
- update
- setupbg
- puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
- set ::tcltest::bgDone 0
- set ::tcltest::bgData {}
- flush $::tcltest::fd
- tkwait variable ::tcltest::bgDone
- set app $::tcltest::bgData
- after 200
- set result [list [catch {send $app foo} msg] $msg]
- close $::tcltest::fd
- set result
-} {1 {target application died}}
-
-winfo interps
-tk appname tktest
-test unixSend-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 unixSend-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 unixSend-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 unixSend-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 {}
-
-# cleanup
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
-