1 files changed, 111 insertions, 31 deletions

diff --git a/tests/send.test b/tests/send.test
index ee2ca74..66c8787 100644
--- a/tests/send.test
+++ b/tests/send.test
@@ -1,6 +1,5 @@
 # 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.
+# other procedures in the file tkSend.c.
 #
 # Copyright © 1994 Sun Microsystems, Inc.
 # Copyright © 1994-1996 Sun Microsystems, Inc.
@@ -10,15 +9,43 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-package require tcltest 2.2
-eval tcltest::configure $argv
-tcltest::loadTestedCommands
+# NOTE
+#
+# Under macOS/aqua, the send command works only with interpreters that exist in
+# the same process. Tests in this test file that target an interpreter in another
+# process carry a constraint "notAqua" so that they are skipped under macos/aqua.
+#
+
+#
+# TESTFILE INITIALIZATION
+#
+
+package require tcltest 2.2; # needed in mode -singleproc 0
+
+# Load the main script main.tcl, which takes care of:
+# - setup for the application and the root window
+# - importing commands from the tcltest namespace
+# - loading of the testutils mechanism along with its utility procs
+# - loading of Tk specific test constraints (additionally to constraints
+#   provided by the package tcltest)
+source [file join [tcltest::configure -testdir] main.tcl]
+
+# Ensure a pristine initial window state
+resetWindows
 
 # Import utility procs for specific functional areas
 testutils import child
 
+#
+# LOCAL TEST CONSTRAINTS
+#
+
 testConstraint xhost [llength [auto_execok xhost]]
 
+#
+# COMMON TEST SETUP
+#
+
 set name [tk appname]
 set commId ""
 catch {
@@ -29,6 +56,10 @@ tk appname tktest
 catch {send t_s_1 destroy .}
 catch {send t_s_2 destroy .}
 
+#
+# TESTS
+#
+
 test send-1.1 {RegOpen procedure, bogus property} {secureserver testsend} {
     testsend bogus
     set result [winfo interps]
@@ -48,8 +79,13 @@ test send-1.3 {RegOpen procedure, bogus property} {secureserver testsend} {
     string range $x [string first " " $x] end
 } " tktest\nabcdefg\n"
 
+#
+# COMMON TEST SETUP
+#
+
 frame .f -width 1 -height 1
 set id [string range [winfo id .f] 2 end]
+
 test send-2.1 {RegFindName procedure} {secureserver testsend} {
     testsend prop root InterpRegistry {}
     list [catch {send foo bar} msg] $msg
@@ -135,7 +171,13 @@ test send-5.4 {ValidateName procedure} {secureserver testsend} {
     winfo interps
 } {test}
 
-if {[testConstraint nonPortable] && [testConstraint xhost]} {
+#
+# COMMON TEST SETUP
+#
+# For tests send-6.*
+#
+
+if {[testConstraint nonPortable] && [testConstraint xhost] && [testConstraint notAqua]} {
     winfo interps
     tk appname tktest
     update
@@ -146,20 +188,24 @@ if {[testConstraint nonPortable] && [testConstraint xhost]} {
     }
 }
 
-test send-6.1 {ServerSecure procedure} {nonPortable secureserver} {
+test send-6.1 {ServerSecure procedure} {nonPortable secureserver notAqua} {
     set a 44
     list [childTkProcess eval [list send [tk appname] set a 55]] $a
 } {55 55}
-test send-6.2 {ServerSecure procedure} {nonPortable secureserver xhost} {
+test send-6.2 {ServerSecure procedure} {nonPortable secureserver xhost notAqua} {
     set a 22
     exec xhost [exec hostname]
     list [catch {childTkProcess eval [list send [tk appname] set a 33]} msg] $a $msg
 } {0 22 {X server insecure (must use xauth-style authorization); command ignored}}
-test send-6.3 {ServerSecure procedure} {nonPortable secureserver xhost} {
+test send-6.3 {ServerSecure procedure} {nonPortable secureserver xhost notAqua} {
     set a abc
     exec xhost - [exec hostname]
     list [childTkProcess eval [list send [tk appname] set a new]] $a
 } {new new}
+
+#
+# COMMON TEST CLEANUP
+#
 childTkProcess exit
 
 test send-7.1 {Tk_SetAppName procedure} {secureserver testsend} {
@@ -194,7 +240,7 @@ test send-8.1 {Tk_SendCmd procedure, options} {secureserver notAqua} {
     childTkProcess exit
     lappend result $a
 } {66 77}
-test send-8.2 {Tk_SendCmd procedure, options} {secureserver altDisplay} {
+test send-8.2 {Tk_SendCmd procedure, options} {secureserver altDisplay notAqua} {
     childTkProcess create -display $env(TK_ALT_DISPLAY)
     tk appname xyzgorp
     set a homeDisplay
@@ -208,6 +254,7 @@ test send-8.2 {Tk_SendCmd procedure, options} {secureserver altDisplay} {
     childTkProcess exit
     set result
 } {altDisplay homeDisplay}
+
 # Since macOS has no registry of interpreters, 8.3 and 8.10 will fail.
 test send-8.3 {Tk_SendCmd procedure, options} {secureserver notAqua} {
     list [catch {send -- -async foo bar baz} msg] $msg
@@ -244,6 +291,10 @@ test send-8.10 {Tk_SendCmd procedure, no such interpreter} {secureserver notAqua
     list [catch {send bogus_name bogus_command} msg] $msg
 } {1 {no application named "bogus_name"}}
 
+#
+# COMMON TEST SETUP
+#
+
 catch {
     childTkInterp t_s_1 -class Test
     t_s_1 eval wm withdraw .
@@ -264,13 +315,12 @@ test send-8.13 {Tk_SendCmd procedure, local execution, different interp} {secure
     send t_s_1 {set a them}
     list $a [send t_s_1 {set a}]
 } {us them}
-test send-8.14 {Tk_SendCmd procedure, local interp killed by send} {secureserver testsend} {
+test send-8.14 {Tk_SendCmd procedure, local interp killed by send} -constraints {secureserver testsend} -body {
     childTkInterp t_s_2 -class Test
     list [catch {send t_s_2 {destroy .; concat result}} msg] $msg
-} {0 result}
-
-catch {interp delete t_s_2}
-
+} -cleanup {
+    catch {interp delete t_s_2}
+} -result {0 result}
 test send-8.15 {Tk_SendCmd procedure, local interp, error info} {secureserver testsend failsOnUbuntu} {
     catch {error foo}
     list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
@@ -289,9 +339,12 @@ test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {secureserver testsend fa
     set result
 } {1 {no application named "bogus"}}
 
+#
+# COMMON TEST CLEANUP
+#
 catch {interp delete t_s_1}
 
-test send-8.17 {Tk_SendCmd procedure, deferring events} {secureserver nonPortable} {
+test send-8.17 {Tk_SendCmd procedure, deferring events} {secureserver nonPortable notAqua} {
     # Non-portable because some window managers ignore "raise"
     # requests so can't guarantee that new app's window won't
     # obscure .f, thereby masking the Expose event.
@@ -311,7 +364,7 @@ test send-8.17 {Tk_SendCmd procedure, deferring events} {secureserver nonPortabl
     childTkProcess exit
     lappend result $a
 } {{no event yet} {no event yet} exposed}
-test send-8.18 {Tk_SendCmd procedure, error in remote app} {secureserver} {
+test send-8.18 {Tk_SendCmd procedure, error in remote app} {secureserver notAqua} {
     childTkProcess create
     set app [childTkProcess eval {tk appname}]
     set result [string tolower [list [catch {send $app open bad_name} msg] \
@@ -323,7 +376,7 @@ test send-8.18 {Tk_SendCmd procedure, error in remote app} {secureserver} {
 "open bad_name"
     invoked from within
 "send $app open bad_name"} {posix enoent {no such file or directory}}}
-test send-8.19 {Tk_SendCmd, using modal timeouts} {secureserver} {
+test send-8.19 {Tk_SendCmd, using modal timeouts} {secureserver notAqua} {
     childTkProcess create
     set app [childTkProcess eval {tk appname}]
     set x no
@@ -336,6 +389,10 @@ test send-8.19 {Tk_SendCmd, using modal timeouts} {secureserver} {
     lappend result $x
 } {{x y z} no yes}
 
+#
+# COMMON TEST SETUP
+#
+
 tk appname tktest
 catch {destroy .f}
 frame .f
@@ -357,6 +414,9 @@ test send-9.3 {Tk_GetInterpNames procedure} {secureserver testsend} {
     list [winfo interps] [testsend prop root InterpRegistry]
 } {{} {}}
 
+#
+# COMMON TEST SETUP
+#
 catch {testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"}
 
 test send-10.1 {SendEventProc procedure, bogus comm property} {secureserver testsend} {
@@ -483,14 +543,14 @@ test send-10.17 {SendEventProc procedure, errorCode and errorInfo} {secureserver
     set errorInfo oldErrorInfo
     list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
 } {4 {} oldErrorInfo oldErrorCode}
-test send-10.18 {SendEventProc procedure, send kills application} {secureserver testsend} {
+test send-10.18 {SendEventProc procedure, send kills application} {secureserver testsend notAqua} {
     childTkProcess create
     childTkProcess eval {tk appname t_s_3}
     set x [list [catch {send t_s_3 destroy .} msg] $msg]
     childTkProcess exit
     set x
 } {0 {}}
-test send-10.19 {SendEventProc procedure, send exits} {secureserver testsend} {
+test send-10.19 {SendEventProc procedure, send exits} {secureserver testsend notAqua} {
     childTkProcess create
     childTkProcess eval {tk appname t_s_3}
     set x [list [catch {send t_s_3 exit} msg] $msg]
@@ -507,16 +567,27 @@ test send-11.2 {AppendPropCarefully and AppendErrorProc procedures} {secureserve
     update
 } {}
 
+#
+# COMMON TEST SETUP
+#
 winfo interps
 tk appname tktest
-catch {destroy .f}
-frame .f
-set id [string range [winfo id .f] 2 end]
 
-test send-12.1 {TimeoutProc procedure} {secureserver testsend} {
+test send-12.1 {TimeoutProc procedure} -constraints {secureserver testsend} -setup {
+    catch {destroy .f}
+    frame .f
+    set id [string range [winfo id .f] 2 end]
+} -body {
     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}}
+} -cleanup {
+    unset id
+    destroy .f
+} -result {1 {target application died or uses a Tk version before 4.0}}
+
+#
+# COMMON TEST CLEANUP
+#
 
 catch {testsend prop root InterpRegistry ""}
 
@@ -536,16 +607,21 @@ test send-12.2 {TimeoutProc procedure} {secureserver notAqua} {
     set result
 } {1 {target application died}}
 
-#macOS does not send to other processes
+#
+# COMMON TEST SETUP
+#
+
 winfo interps
 tk appname tktest
-test send-13.1 {DeleteProc procedure} {secureserver notAqua} {
+
+#macOS does not send to other processes
+test send-13.1 {DeleteProc procedure} -constraints {secureserver notAqua} -body {
     childTkProcess create
     set app [childTkProcess eval {rename send {}; tk appname}]
     set result [list [catch {send $app foo} msg] $msg [winfo interps]]
     childTkProcess exit
     set result
-} {1 {no application named "tktest #2"} tktest}
+} -result {1 {no application named "tktest[0-9]+"} tktest} -match regexp
 test send-13.2 {DeleteProc procedure} {secureserver notAqua} {
     winfo interps
     tk appname tktest
@@ -556,7 +632,7 @@ test send-13.2 {DeleteProc procedure} {secureserver notAqua} {
     lappend result [winfo interps] [info commands send]
 } {{} {} foo send}
 
-test send-14.1 {SendRestrictProc procedure, sends crossing from different displays} {secureserver altDisplay} {
+test send-14.1 {SendRestrictProc procedure, sends crossing from different displays} {secureserver altDisplay notAqua} {
     childTkProcess create -display $env(TK_ALT_DISPLAY)
     set result [childTkProcess eval "
     toplevel .t -screen [winfo screen .]
@@ -575,10 +651,15 @@ test send-14.1 {SendRestrictProc procedure, sends crossing from different displa
     set result
 } {child parent}
 
+#
+# COMMON TEST SETUP
+#
+
 catch {
     testsend prop root InterpRegister $registry
     tk appname tktest
 }
+
 test send-15.1 {UpdateCommWindow procedure} {secureserver testsend} {
     set x [list [testsend prop comm TK_APPLICATION]]
     childTkInterp t_s_1 -class Test
@@ -593,7 +674,7 @@ test send-15.1 {UpdateCommWindow procedure} {secureserver testsend} {
 } {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest}
 
 #
-# CLEANUP
+# TESTFILE CLEANUP
 #
 
 catch {
@@ -604,4 +685,3 @@ catch {
 
 testutils forget child
 cleanupTests
-return