diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2004-05-23 17:34:48 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2004-05-23 17:34:48 (GMT) |
commit | 7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba (patch) | |
tree | c1834b8cace8654026ee20f8fd75ea3f340a902c /tests/select.test | |
parent | fc07382fecf576d43fc28117ca52416170fb0f4f (diff) | |
download | tk-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.test | 64 |
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 - - - - - - - - - - - - - |