summaryrefslogtreecommitdiffstats
path: root/tests/select.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-05-23 17:34:48 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-05-23 17:34:48 (GMT)
commit7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba (patch)
treec1834b8cace8654026ee20f8fd75ea3f340a902c /tests/select.test
parentfc07382fecf576d43fc28117ca52416170fb0f4f (diff)
downloadtk-7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba.zip
tk-7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba.tar.gz
tk-7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba.tar.bz2
First step towards improving test style. Also start using Tcl 8.5 features.
Diffstat (limited to 'tests/select.test')
-rw-r--r--tests/select.test64
1 files changed, 24 insertions, 40 deletions
diff --git a/tests/select.test b/tests/select.test
index 24bae6d..d8b67e3 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: select.test,v 1.12 2004/03/17 18:15:50 das Exp $
+# RCS: @(#) $Id: select.test,v 1.13 2004/05/23 17:34:49 dkf Exp $
#
# Note: Multiple display selection handling will only be tested if the
@@ -764,50 +764,50 @@ test select-6.39 {Tk_SelectionCmd procedure} {
##############################################################################
- # This test is non-portable because some old X11/News servers ignore
- # a selection request when the window doesn't exist, which causes a
- # different error message.
+# This test is non-portable because some old X11/News servers ignore
+# a selection request when the window doesn't exist, which causes a
+# different error message.
- test select-7.1 {TkSelDeadWindow procedure} {nonPortable} {
- setup
- selection handle .f1 { handler TEST }
- set result [selection own]
- destroy .f1
- lappend result [selection own] [catch { selection get } msg] $msg
- } {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
+test select-7.1 {TkSelDeadWindow procedure} nonPortable {
+ setup
+ selection handle .f1 { handler TEST }
+ set result [selection own]
+ destroy .f1
+ lappend result [selection own] [catch {selection get} msg] $msg
+} {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
##############################################################################
# Check reentrancy on losing selection
-test select-8.1 {TkSelEventProc procedure} {unixOnly} {
+test select-8.1 {TkSelEventProc procedure} -constraints unixOnly -setup {
setup
setupbg
- selection own -selection CLIPBOARD -command { destroy .f1 } .f1
+} -body {
+ selection own -selection CLIPBOARD -command {destroy .f1} .f1
update
- set result [dobg {selection own -selection CLIPBOARD .}]
+ dobg {selection own -selection CLIPBOARD .}
+} -cleanup {
cleanupbg
- set result
-} {}
+} -result {}
##############################################################################
-test select-9.1 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
- global selValue selInfo
+test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup {
setup
setupbg
+} -constraint unixOnly -body {
set selValue "1024"
set selInfo ""
selection handle -selection PRIMARY -format INTEGER -type TEST \
- .f1 {handler TEST}
+ .f1 {handler TEST}
update
set result ""
lappend result [dobg {selection get TEST}]
cleanupbg
lappend result $selInfo
-} {0x400 {TEST 0 4000}}
-test select-9.2 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
- global selValue selInfo
+} -result {0x400 {TEST 0 4000}}
+test select-9.2 {SelCvtToX and SelCvtFromX procedures} unixOnly {
setup
setupbg
set selValue "1024 0xffff 2048 -2 "
@@ -819,8 +819,7 @@ test select-9.2 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
cleanupbg
lappend result $selInfo
} {{0x400 0xffff 0x800 0xfffffffe} {TEST 0 4000}}
-test select-9.3 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
- global selValue selInfo
+test select-9.3 {SelCvtToX and SelCvtFromX procedures} unixOnly {
setup
setupbg
set selValue " "
@@ -832,8 +831,7 @@ test select-9.3 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
cleanupbg
lappend result $selInfo
} {{} {TEST 0 4000}}
-test select-9.4 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
- global selValue selInfo
+test select-9.4 {SelCvtToX and SelCvtFromX procedures} unixOnly {
setup
setupbg
set selValue "16 foobar 32"
@@ -1004,7 +1002,6 @@ test select-12.5 {DefaultSelection procedure} {unixOnly} {
set result
} {.f1 .f1}
test select-12.6 {DefaultSelection procedure} {
- global selValue selInfo
setup
selection handle .f1 {handler TARGETS.f1} TARGETS
set selValue "Targets value"
@@ -1045,16 +1042,3 @@ catch {rename weirdHandler {}}
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-