diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | tests/canvPs.test | 6 | ||||
| -rw-r--r-- | tests/choosedir.test | 22 | ||||
| -rw-r--r-- | tests/clipboard.test | 4 | ||||
| -rw-r--r-- | tests/clrpick.test | 4 | ||||
| -rw-r--r-- | tests/cursor.test | 8 | ||||
| -rw-r--r-- | tests/entry.test | 20 | ||||
| -rw-r--r-- | tests/focus.test | 117 | ||||
| -rw-r--r-- | tests/font.test | 30 | ||||
| -rw-r--r-- | tests/frame.test | 8 | ||||
| -rw-r--r-- | tests/id.test | 4 | ||||
| -rw-r--r-- | tests/menuDraw.test | 20 | ||||
| -rw-r--r-- | tests/menubut.test | 6 | ||||
| -rw-r--r-- | tests/scrollbar.test | 94 | ||||
| -rw-r--r-- | tests/select.test | 76 | ||||
| -rw-r--r-- | tests/spinbox.test | 12 | ||||
| -rw-r--r-- | tests/text.test | 6 | ||||
| -rw-r--r-- | tests/textDisp.test | 8 | ||||
| -rw-r--r-- | tests/tk.test | 8 | ||||
| -rw-r--r-- | tests/unixMenu.test | 6 | ||||
| -rw-r--r-- | tests/unixSelect.test | 40 | ||||
| -rw-r--r-- | tests/unixWm.test | 4 | ||||
| -rw-r--r-- | tests/winButton.test | 20 | ||||
| -rw-r--r-- | tests/winClipboard.test | 16 | ||||
| -rw-r--r-- | tests/winFont.test | 62 | ||||
| -rw-r--r-- | tests/winMenu.test | 292 | ||||
| -rw-r--r-- | tests/winWm.test | 42 | ||||
| -rw-r--r-- | tests/window.test | 8 | ||||
| -rw-r--r-- | tests/winfo.test | 10 | ||||
| -rw-r--r-- | tests/wm.test | 12 | ||||
| -rw-r--r-- | tests/xmfbox.test | 18 |
31 files changed, 489 insertions, 498 deletions
@@ -1,3 +1,7 @@ +2004-06-24 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * tests/canvPs.test, etc: Use standard tcltest constraint names. + 2004-06-19 Daniel Steffen <das@users.sourceforge.net> * unix/tcl.m4: autoconf 2.5 fixes in Darwin section. diff --git a/tests/canvPs.test b/tests/canvPs.test index e57b9b9..8921450 100644 --- a/tests/canvPs.test +++ b/tests/canvPs.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: canvPs.test,v 1.8 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: canvPs.test,v 1.9 2004/06/24 12:45:42 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -59,7 +59,7 @@ test canvPs-2.2 {test writing to channel, idempotency} {unixOrPc} { } set status } ok -test canvPs-2.3 {test writing to channel and file, same output} {unixOnly} { +test canvPs-2.3 {test writing to channel and file, same output} unix { removeFile foo.ps removeFile bar.ps set c1 [open foo.ps w] @@ -73,7 +73,7 @@ test canvPs-2.3 {test writing to channel and file, same output} {unixOnly} { } set status } ok -test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} { +test canvPs-2.4 {test writing to channel and file, same output} win { removeFile foo.ps removeFile bar.ps set c1 [open foo.ps w] diff --git a/tests/choosedir.test b/tests/choosedir.test index d72dbcd..540c686 100644 --- a/tests/choosedir.test +++ b/tests/choosedir.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: choosedir.test,v 1.12 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: choosedir.test,v 1.13 2004/06/24 12:45:42 dkf Exp $ # package require tcltest 2.1 @@ -89,24 +89,24 @@ set real [file join $dir choosedirTest] set parent . foreach opt {-initialdir -mustexist -parent -title} { - test choosedir-1.1$opt "tk_chooseDirectory command" unixOnly { + test choosedir-1.1$opt "tk_chooseDirectory command" unix { list [catch {tk_chooseDirectory $opt} msg] $msg } [list 1 "value for \"$opt\" missing"] } -test choosedir-1.2 "tk_chooseDirectory command" unixOnly { +test choosedir-1.2 "tk_chooseDirectory command" unix { list [catch {tk_chooseDirectory -foo bar} msg] $msg } [list 1 "bad option \"-foo\": must be -initialdir, -mustexist, -parent, or -title"] -test choosedir-1.3 "tk_chooseDirectory command" unixOnly { +test choosedir-1.3 "tk_chooseDirectory command" unix { list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg } {1 {bad window path name "foo.bar"}} -test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unixOnly} { +test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" unix { ToPressButton $parent cancel tk_chooseDirectory -title "Press Cancel" -parent $parent } "" -test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly} { +test choosedir-3.1 "tk_chooseDirectory -mustexist 1" unix { # first enter a bogus dirname, then enter a real one. ToEnterDirsByKey $parent [list $fake $real $real] set result [tk_chooseDirectory \ @@ -114,23 +114,23 @@ test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unixOnly} { -parent $parent -mustexist 1] set result } $real -test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unixOnly} { +test choosedir-3.2 "tk_chooseDirectory -mustexist 0" unix { ToEnterDirsByKey $parent [list $fake $fake] tk_chooseDirectory -title "Enter \"$fake\", press OK" \ -parent $parent -mustexist 0 } $fake -test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unixOnly} { +test choosedir-4.1 "tk_chooseDirectory command, initialdir" unix { ToPressButton $parent ok tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real } $real -test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unixOnly} { +test choosedir-4.2 "tk_chooseDirectory command, initialdir" unix { ToEnterDirsByKey $parent [list $fake $fake] tk_chooseDirectory \ -title "Enter \"$fake\" and press Ok" \ -parent $parent -initialdir $real } $fake -test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unixOnly} { +test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" unix { catch {unset ::tk::dialog::file::__tk_choosedir} ToPressButton $parent ok tk_chooseDirectory \ @@ -138,7 +138,7 @@ test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unixOnly} { -parent $parent -initialdir "" } [pwd] -test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unixOnly} { +test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" unix { ToEnterDirsByKey $parent [list "" $real $real] tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \ -parent $parent diff --git a/tests/clipboard.test b/tests/clipboard.test index b8530a6..bca910b 100644 --- a/tests/clipboard.test +++ b/tests/clipboard.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: clipboard.test,v 1.8 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: clipboard.test,v 1.9 2004/06/24 12:45:42 dkf Exp $ # # Note: Multiple display clipboard handling will only be tested if the @@ -163,7 +163,7 @@ test clipboard-6.1 {Tk_ClipboardAppend procedure} { clipboard get } msg] $msg } {0 {first chunk second chunk}} -test clipboard-6.2 {Tk_ClipboardAppend procedure} {unixOnly} { +test clipboard-6.2 {Tk_ClipboardAppend procedure} unix { setupbg clipboard clear clipboard append -f INTEGER -t TEST "16" diff --git a/tests/clrpick.test b/tests/clrpick.test index 9396dbb..341a6de 100644 --- a/tests/clrpick.test +++ b/tests/clrpick.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: clrpick.test,v 1.11 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: clrpick.test,v 1.12 2004/06/24 12:45:42 dkf Exp $ # package require tcltest 2.1 @@ -192,7 +192,7 @@ test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} { tk_chooseColor -parent $parent -title "Press Cancel" } "" -test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} unixOnly { +test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} unix { after 50 {set ::scr [winfo screen .__tk__color]} ToPressButton $parent cancel tk_chooseColor -parent $parent diff --git a/tests/cursor.test b/tests/cursor.test index da8b758..350ee91 100644 --- a/tests/cursor.test +++ b/tests/cursor.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: cursor.test,v 1.13 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: cursor.test,v 1.14 2004/06/24 12:45:42 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -80,11 +80,11 @@ foreach wincur(num) $wincur(data_octal) { } set wincur(dir) [makeDirectory {dir with spaces}] set wincur(file) [makeFile $wincur(data_binary) "test file.cur" $wincur(dir)] -test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} {pcOnly} { +test cursor-2.3 {Tk_GetCursor procedure: cursor specs are lists} win { destroy .b1 button .b1 -cursor [list @$wincur(file)] } {.b1} -test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} {pcOnly} { +test cursor-2.4 {Tk_GetCursor procedure: cursor specs are lists} win { destroy .b1 button .b1 -cursor @[regsub -all {[][ \\{}""$#]} $wincur(file) {\\&}] } {.b1} @@ -242,7 +242,7 @@ foreach {testName cursor} { cursor-7.8 uparrow cursor-7.9 wait } { - test testName "check Windows cursor $cursor" -constraints pcOnly -setup { + test testName "check Windows cursor $cursor" -constraints win -setup { button .b -text $cursor } -body { .b configure -cursor $cursor diff --git a/tests/entry.test b/tests/entry.test index 8a5713e..f17ad21 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: entry.test,v 1.17 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: entry.test,v 1.18 2004/06/24 12:45:42 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -753,7 +753,7 @@ test entry-6.9 {EntryComputeGeometry procedure} {fonts} { update list [winfo reqwidth .e] [winfo reqheight .e] } {25 39} -test entry-6.10 {EntryComputeGeometry procedure} {unixOnly fonts} { +test entry-6.10 {EntryComputeGeometry procedure} {unix fonts} { catch {destroy .e} entry .e -bd 1 -relief raised -width 0 -show . .e insert 0 12345 @@ -765,7 +765,7 @@ test entry-6.10 {EntryComputeGeometry procedure} {unixOnly fonts} { .e configure -show "" lappend x [winfo reqwidth .e] } {23 53 43} -test entry-6.11 {EntryComputeGeometry procedure} {pcOnly} { +test entry-6.11 {EntryComputeGeometry procedure} win { catch {destroy .e} entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12} .e insert 0 12345 @@ -1195,26 +1195,26 @@ test entry-13.9 {GetEntryIndex procedure} { list [.e index sel.first] [.e index sel.last] } {1 6} selection clear .e -test entry-13.10 {GetEntryIndex procedure} {unixOnly} { +test entry-13.10 {GetEntryIndex procedure} unix { # On unix, when selection is cleared, entry widget's internal # selection range is reset. list [catch {.e index sel.first} msg] $msg } {1 {selection isn't in widget .e}} -test entry-13.11 {GetEntryIndex procedure} {pcOnly} { +test entry-13.11 {GetEntryIndex procedure} win { # On mac and pc, when selection is cleared, entry widget remembers # last selected range. When selection ownership is restored to # entry, the old range will be rehighlighted. list [catch {selection get}] [.e index sel.first] } {1 1} -test entry-13.12 {GetEntryIndex procedure} {unixOnly} { +test entry-13.12 {GetEntryIndex procedure} unix { list [catch {.e index sbogus} msg] $msg } {1 {selection isn't in widget .e}} -test entry-13.13 {GetEntryIndex procedure} {pcOnly} { +test entry-13.13 {GetEntryIndex procedure} win { list [catch {.e index sbogus} msg] $msg } {1 {bad entry index "sbogus"}} -test entry-13.14 {GetEntryIndex procedure} {pcOnly} { +test entry-13.14 {GetEntryIndex procedure} win { list [catch {selection get}] [catch {.e index sbogus}] } {1 1} test entry-13.15 {GetEntryIndex procedure} { @@ -1315,13 +1315,13 @@ test entry-16.1 {EntryVisibleRange procedure} {fonts} { .e insert 0 ............................. .e xview } {0 0.827586} -test entry-15.2 {EntryVisibleRange procedure} {unixOnly fonts} { +test entry-15.2 {EntryVisibleRange procedure} {unix fonts} { .e configure -show X .e delete 0 end .e insert 0 ............................. .e xview } {0 0.275862} -test entry-15.3 {EntryVisibleRange procedure} {pcOnly} { +test entry-15.3 {EntryVisibleRange procedure} win { .e configure -show . .e delete 0 end .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX diff --git a/tests/focus.test b/tests/focus.test index 312c4d4..af04870 100644 --- a/tests/focus.test +++ b/tests/focus.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: focus.test,v 1.10 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: focus.test,v 1.11 2004/06/24 12:45:42 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -70,35 +70,35 @@ bind all <KeyPress> { append focusInfo "press %W %K" } -test focus-1.1 {Tk_FocusCmd procedure} {unixOnly} { +test focus-1.1 {Tk_FocusCmd procedure} unix { focusClear focus } {} -test focus-1.2 {Tk_FocusCmd procedure} {unixOnly altDisplay} { +test focus-1.2 {Tk_FocusCmd procedure} {unix altDisplay} { focus .alt.b focus } {} -test focus-1.3 {Tk_FocusCmd procedure} {unixOnly} { +test focus-1.3 {Tk_FocusCmd procedure} unix { focusClear focus .t.b3 focus } {} -test focus-1.4 {Tk_FocusCmd procedure} {unixOnly} { +test focus-1.4 {Tk_FocusCmd procedure} unix { list [catch {focus ""} msg] $msg } {0 {}} -test focus-1.5 {Tk_FocusCmd procedure} {unixOnly} { +test focus-1.5 {Tk_FocusCmd procedure} unix { focusClear focus -force .t focus .t.b3 focus } {.t.b3} -test focus-1.6 {Tk_FocusCmd procedure} {unixOnly} { +test focus-1.6 {Tk_FocusCmd procedure} unix { list [catch {focus .gorp} msg] $msg } {1 {bad window path name ".gorp"}} -test focus-1.7 {Tk_FocusCmd procedure} {unixOnly} { +test focus-1.7 {Tk_FocusCmd procedure} unix { list [catch {focus .gorp a} msg] $msg } {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}} -test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {unixOnly} { +test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} unix { toplevel .t2 wm geom .t2 +10+10 frame .t2.f -width 200 -height 100 -bd 2 -relief raised @@ -117,73 +117,73 @@ test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {unixOnly} { destroy .t2 set x } {.t2.f2 .t2 .t2} -test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { +test focus-1.9 {Tk_FocusCmd procedure, -displayof option} unix { list [catch {focus -displayof} msg] $msg } {1 {wrong # args: should be "focus -displayof window"}} -test focus-1.10 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { +test focus-1.10 {Tk_FocusCmd procedure, -displayof option} unix { list [catch {focus -displayof a b} msg] $msg } {1 {wrong # args: should be "focus -displayof window"}} -test focus-1.11 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { +test focus-1.11 {Tk_FocusCmd procedure, -displayof option} unix { list [catch {focus -displayof .lousy} msg] $msg } {1 {bad window path name ".lousy"}} -test focus-1.12 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { +test focus-1.12 {Tk_FocusCmd procedure, -displayof option} unix { focusClear focus .t focus -displayof .t.b3 } {} -test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {unixOnly} { +test focus-1.13 {Tk_FocusCmd procedure, -displayof option} unix { focusClear focus -force .t focus -displayof .t.b3 } {.t} -test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unixOnly altDisplay} { +test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unix altDisplay} { focus -force .alt.c focus -displayof .alt } {.alt.c} -test focus-1.15 {Tk_FocusCmd procedure, -force option} {unixOnly} { +test focus-1.15 {Tk_FocusCmd procedure, -force option} unix { list [catch {focus -force} msg] $msg } {1 {wrong # args: should be "focus -force window"}} -test focus-1.16 {Tk_FocusCmd procedure, -force option} {unixOnly} { +test focus-1.16 {Tk_FocusCmd procedure, -force option} unix { list [catch {focus -force a b} msg] $msg } {1 {wrong # args: should be "focus -force window"}} -test focus-1.17 {Tk_FocusCmd procedure, -force option} {unixOnly} { +test focus-1.17 {Tk_FocusCmd procedure, -force option} unix { list [catch {focus -force foo} msg] $msg } {1 {bad window path name "foo"}} -test focus-1.18 {Tk_FocusCmd procedure, -force option} {unixOnly} { +test focus-1.18 {Tk_FocusCmd procedure, -force option} unix { list [catch {focus -force ""} msg] $msg } {0 {}} -test focus-1.19 {Tk_FocusCmd procedure, -force option} {unixOnly} { +test focus-1.19 {Tk_FocusCmd procedure, -force option} unix { focusClear focus .t.b1 set x [list [focus]] focus -force .t.b1 lappend x [focus] } {{} .t.b1} -test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { +test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} unix { list [catch {focus -lastfor} msg] $msg } {1 {wrong # args: should be "focus -lastfor window"}} -test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { +test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} unix { list [catch {focus -lastfor 1 2} msg] $msg } {1 {wrong # args: should be "focus -lastfor window"}} -test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { +test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} unix { list [catch {focus -lastfor who_knows?} msg] $msg } {1 {bad window path name "who_knows?"}} -test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { +test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} unix { focus .b focus .t.b1 list [focus -lastfor .] [focus -lastfor .t.b3] } {.b .t.b1} -test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} { +test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} unix { destroy .t focusSetup update focus -lastfor .t.b2 } {.t} -test focus-1.25 {Tk_FocusCmd procedure} {unixOnly} { +test focus-1.25 {Tk_FocusCmd procedure} unix { list [catch {focus -unknown} msg] $msg } {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}} -test focus-2.1 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { +test focus-2.1 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { focus -force .b destroy .t focusSetup @@ -193,7 +193,7 @@ test focus-2.1 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} -sendevent 0x54217567 list $focusInfo } {{}} -test focus-2.2 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { +test focus-2.2 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { focus -force .b destroy .t focusSetup @@ -203,7 +203,7 @@ test focus-2.2 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} list $focusInfo [focus] } {{in .t NotifyAncestor } .b} -test focus-2.3 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} { +test focus-2.3 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { focus -force .b destroy .t focusSetup @@ -217,7 +217,7 @@ out . NotifyNonlinearVirtual in .t NotifyNonlinear } .t} test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \ - {unixOnly nonPortable testwrapper} { + {unix nonPortable testwrapper} { set result {} focus .t.b1 # Important to end with NotifyAncestor, which is an @@ -248,7 +248,7 @@ in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear }} test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \ - {unixOnly nonPortable testwrapper} { + {unix nonPortable testwrapper} { focusSetup focus .t.b1 update @@ -259,7 +259,7 @@ in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } .t.b1} test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ - {unixOnly testwrapper} { + {unix testwrapper} { focus .t.b1 focus . update @@ -270,7 +270,7 @@ test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ list $x $focusInfo } {.t.b1 {press .t.b1 x}} test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \ - {unixOnly testwrapper} { + {unix testwrapper} { set result {} foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot @@ -283,19 +283,19 @@ test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \ set result } {{} .t.b1 {} {} .t.b1 .t.b1 {}} test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \ - {unixOnly testwrapper} { + {unix testwrapper} { focus -force .t.b1 event gen .t.b1 <FocusOut> -detail NotifyAncestor focus } {.t.b1} test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \ - {unixOnly testwrapper} { + {unix testwrapper} { focus .t.b1 event gen [testwrapper .] <FocusOut> -detail NotifyAncestor focus } {} test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \ - {unixOnly testwrapper} { + {unix testwrapper} { set result {} focus .t.b1 focusClear @@ -310,7 +310,7 @@ test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \ set result } {.t.b1 {} .t.b1 .t.b1 .t.b1} test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \ - {unixOnly testwrapper} { + {unix testwrapper} { focusClear set focusInfo {} event gen [testwrapper .t] <Enter> -detail NotifyAncestor @@ -318,7 +318,7 @@ test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \ set focusInfo } {} test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \ - {unixOnly testwrapper} { + {unix testwrapper} { focus -force .b update set focusInfo {} @@ -327,7 +327,7 @@ test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \ set focusInfo } {} test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \ - {unixOnly testwrapper} { + {unix testwrapper} { focus .t.b1 focusClear event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 @@ -337,7 +337,7 @@ test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \ } {in .t NotifyVirtual in .t.b1 NotifyAncestor } -test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unixOnly testwrapper} { +test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unix testwrapper} { focusClear catch {destroy .t2} toplevel .t2 @@ -349,7 +349,7 @@ test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when destroy .t2 } {} test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \ - {unixOnly testwrapper} { + {unix testwrapper} { set result {} focus .t.b1 foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear @@ -364,7 +364,7 @@ test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \ set result } {{} .t.b1 {} {} {}} test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \ - {unixOnly testwrapper} { + {unix testwrapper} { set result {} focus .t.b1 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 @@ -377,7 +377,7 @@ test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \ out .t NotifyVirtual } test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \ - {unixOnly testwrapper} { + {unix testwrapper} { set result {} focus .t.b1 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 @@ -392,7 +392,7 @@ out .t NotifyVirtual } {}} test focus-3.1 {SetFocus procedure, create record on focus} \ - {unixOnly testwrapper} { + {unix testwrapper} { toplevel .t2 -width 250 -height 100 wm geometry .t2 +0+0 update @@ -404,8 +404,7 @@ catch {destroy .t2} # This test produces no result, but it will generate a protocol # error if Tk forgets to make the window exist before focussing # on it. -test focus-3.2 {SetFocus procedure, making window exist} \ - {unixOnly testwrapper} { +test focus-3.2 {SetFocus procedure, making window exist} {unix testwrapper} { update button .b2 -text "Another button" focus .b2 @@ -416,13 +415,13 @@ update # The following test doesn't produce a check-able result, but if # there are bugs it may generate an X protocol error. test focus-3.3 {SetFocus procedure, delaying claim of X focus} \ - {unixOnly testwrapper} { + {unix testwrapper} { focusSetup focus -force .t.b2 update } {} test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ - {unixOnly testwrapper} { + {unix testwrapper} { focusSetup wm withdraw .t focus -force .t.b2 @@ -435,8 +434,7 @@ test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ wm deiconify .t } {} catch {destroy .t2} -test focus-3.5 {SetFocus procedure, generating events} \ - {unixOnly testwrapper} { +test focus-3.5 {SetFocus procedure, generating events} {unix testwrapper} { focusSetup focusClear set focusInfo {} @@ -446,8 +444,7 @@ test focus-3.5 {SetFocus procedure, generating events} \ } {in .t NotifyVirtual in .t.b2 NotifyAncestor } -test focus-3.6 {SetFocus procedure, generating events} \ - {unixOnly testwrapper} { +test focus-3.6 {SetFocus procedure, generating events} {unix testwrapper} { focusSetup focus -force .b update @@ -461,7 +458,7 @@ in .t NotifyNonlinearVirtual in .t.b2 NotifyNonlinear } test focus-3.7 {SetFocus procedure, generating events} \ - {unixOnly nonPortable testwrapper} { + {unix nonPortable testwrapper} { # Non-portable because some platforms generate extra events. focusSetup @@ -472,7 +469,7 @@ test focus-3.7 {SetFocus procedure, generating events} \ set focusInfo } {} -test focus-4.1 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { +test focus-4.1 {TkFocusDeadWindow procedure} {unix testwrapper} { focusSetup update focus -force .b @@ -480,7 +477,7 @@ test focus-4.1 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { destroy .t focus } {.b} -test focus-4.2 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { +test focus-4.2 {TkFocusDeadWindow procedure} {unix testwrapper} { focusSetup update focus -force .t.b2 @@ -494,7 +491,7 @@ test focus-4.2 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { # Non-portable due to wm-specific redirection of input focus when # windows are deleted: -test focus-4.3 {TkFocusDeadWindow procedure} {unixOnly nonPortable testwrapper} { +test focus-4.3 {TkFocusDeadWindow procedure} {unix nonPortable testwrapper} { focusSetup update focus .t @@ -503,7 +500,7 @@ test focus-4.3 {TkFocusDeadWindow procedure} {unixOnly nonPortable testwrapper} update focus } {} -test focus-4.4 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { +test focus-4.4 {TkFocusDeadWindow procedure} {unix testwrapper} { focusSetup focus -force .t.b2 update @@ -516,7 +513,7 @@ test focus-4.4 {TkFocusDeadWindow procedure} {unixOnly testwrapper} { setupbg test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \ - {unixOnly testwrapper secureserver} { + {unix testwrapper secureserver} { focusSetup focus -force .t update @@ -536,7 +533,7 @@ cleanupbg fixfocus test focus-6.1 {miscellaneous - embedded application in same process} \ - {unixOnly testwrapper} { + {unix testwrapper} { eval interp delete [interp slaves] catch {destroy .t} toplevel .t @@ -586,7 +583,7 @@ test focus-6.1 {miscellaneous - embedded application in same process} \ set result } {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} test focus-6.2 {miscellaneous - embedded application in different process} \ - {unixOnly testwrapper} { + {unix testwrapper} { eval interp delete [interp slaves] catch {destroy .t} setupbg diff --git a/tests/font.test b/tests/font.test index cc0aa45..c0d5fcf 100644 --- a/tests/font.test +++ b/tests/font.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: font.test,v 1.11 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: font.test,v 1.12 2004/06/24 12:45:42 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -134,11 +134,11 @@ test font-4.8 {font command: actual: all attributes} { # not (objc > 3) so objPtr = NULL lindex [font actual {-family times}] 0 } {-family} -test font-4.9 {font command: actual} {unixOnly noExceed} { +test font-4.9 {font command: actual} {unix noExceed} { # (objc > 3) so objPtr = objv[3 + skip] string tolower [font actual {-family times} -family] } {times} -test font-4.10 {font command: actual} {pcOnly} { +test font-4.10 {font command: actual} win { # (objc > 3) so objPtr = objv[3 + skip] font actual {-family times} -family } {Times New Roman} @@ -496,12 +496,12 @@ test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} { setup .b.f config -font {times 20} } {} -test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} { +test font-15.7 {Tk_AllocFontFromObj procedure: get native font} unix { # not (fontPtr == NULL) setup .b.f config -font fixed } {} -test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} { +test font-15.8 {Tk_AllocFontFromObj procedure: get native font} win { # not (fontPtr == NULL) setup .b.f config -font oemfixed @@ -642,7 +642,7 @@ proc psfontname {name} { set start [string first "gsave" $post] return [string range $post [expr $start+7] end] } -test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} { +test font-21.1 {Tk_PostscriptFontName procedure: native} unix { set x [font actual {{itc avant garde} 10} -family] if {[string match *avant*garde $x]} { psfontname "{itc avant garde} 10" @@ -650,16 +650,16 @@ test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} { set x {AvantGarde-Book} } } {AvantGarde-Book} -test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} { +test font-21.2 {Tk_PostscriptFontName procedure: native} win { psfontname "arial 10" } {Helvetica} -test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} { +test font-21.3 {Tk_PostscriptFontName procedure: native} win { psfontname "{times new roman} 10" } {Times-Roman} -test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} { +test font-21.4 {Tk_PostscriptFontName procedure: native} win { psfontname "{courier new} 10" } {Courier} -test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} { +test font-21.8 {Tk_PostscriptFontName procedure: spaces} unix { set x [font actual {{lucida bright} 10} -family] if {[string match lucida*bright $x]} { psfontname "{lucida bright} 10" @@ -667,7 +667,7 @@ test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} { set x {LucidaBright} } } {LucidaBright} -test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} { +test font-21.9 {Tk_PostscriptFontName procedure: spaces} unix { psfontname "{new century schoolbook} 10" } {NewCenturySchlbk-Roman} set i 10 @@ -697,7 +697,7 @@ foreach p { ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats} } { set values [lassign $p testName family] - test $testName {Tk_PostscriptFontName procedure: exhaustive} unixOnly { + test $testName {Tk_PostscriptFontName procedure: exhaustive} unix { set x {} set j 0 foreach slant {roman italic} { @@ -727,7 +727,7 @@ foreach p { Times-Roman Times-Bold Times-Italic Times-BoldItalic} } { set values [lassign $p testName family] - test $testName {Tk_PostscriptFontName procedure: exhaustive} pcOnly { + test $testName {Tk_PostscriptFontName procedure: exhaustive} win { set x {} foreach slant {roman italic} { foreach weight {normal bold} { @@ -1322,10 +1322,10 @@ tk scaling $oldscale test font-45.1 {TkFontGetAliasList: no match} { font actual {snarky 10} -family } [font actual {-size 10} -family] -test font-45.3 {TkFontGetAliasList: match} {pcOnly} { +test font-45.3 {TkFontGetAliasList: match} win { font actual {times 10} -family } {Times New Roman} -test font-45.4 {TkFontGetAliasList: match} {unixOnly noExceed} { +test font-45.4 {TkFontGetAliasList: match} {unix noExceed} { # can fail on Unix systems that have a real "times new roman" font font actual {{times new roman} 10} -family } [font actual {times 10} -family] diff --git a/tests/frame.test b/tests/frame.test index ab50de5..f43655f 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: frame.test,v 1.13 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: frame.test,v 1.14 2004/06/24 12:45:43 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -313,7 +313,7 @@ test frame-3.8 {TkCreateFrame procedure} { test frame-3.9 {TkCreateFrame procedure, -use option} -setup { catch {destroy .t} catch {destroy .x} -} -constraints unixOnly -body { +} -constraints unix -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green @@ -327,7 +327,7 @@ test frame-3.9 {TkCreateFrame procedure, -use option} -setup { test frame-3.10 {TkCreateFrame procedure, -use option} -setup { catch {destroy .t} catch {destroy .x} -} -constraints unixOnly -body { +} -constraints unix -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 option add *x.use [winfo id .t] @@ -386,7 +386,7 @@ test frame-3.14 {TkCreateFrame procedure} {defaultPseudocolor8 nonPortable} { test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -setup { catch {destroy .t} catch {destroy .x} -} -constraints {defaultPseudocolor8 unixOnly nonPortable} -body { +} -constraints {defaultPseudocolor8 unix nonPortable} -body { toplevel .t -container 1 -width 300 -height 120 wm geometry .t +0+0 toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new diff --git a/tests/id.test b/tests/id.test index b1933db..bc8c5c6 100644 --- a/tests/id.test +++ b/tests/id.test @@ -6,13 +6,13 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: id.test,v 1.8 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: id.test,v 1.9 2004/06/24 12:45:43 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands -test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly testwrapper} { +test id-1.1 {WindowIdCleanup, delaying window release} {unix testwrapper} { bind all <Destroy> {lappend x %W} catch {unset map} frame .f diff --git a/tests/menuDraw.test b/tests/menuDraw.test index b217948..f4122f1 100644 --- a/tests/menuDraw.test +++ b/tests/menuDraw.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menuDraw.test,v 1.8 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: menuDraw.test,v 1.9 2004/06/24 12:45:43 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -163,7 +163,7 @@ test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} { } {{} {}} -test menuDraw-8.1 {TkRecomputeMenu} {pcOnly userInteraction} { +test menuDraw-8.1 {TkRecomputeMenu} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 configure -postcommand [.m1 add command -label foo] @@ -254,7 +254,7 @@ test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} testImageType { } {{} {} {}} #Don't know how to test missing tkwin in DisplayMenu -test menuDraw-12.1 {DisplayMenu - menubar background} {unixOnly} { +test menuDraw-12.1 {DisplayMenu - menubar background} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo -menu .m2 @@ -312,7 +312,7 @@ test menuDraw.12.7 {DisplayMenu - three columns} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test menuDraw-12.6 {Display menu - testing for extra space and menubars} {unixOnly} { +test menuDraw-12.6 {Display menu - testing for extra space and menubars} unix { catch {destroy .m1} menu .m1 .m1 add cascade -label foo @@ -422,7 +422,7 @@ test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} { } {0 {}} -test menuDraw-16.1 {TkPostSubmenu} {unixOnly} { +test menuDraw-16.1 {TkPostSubmenu} unix { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -433,7 +433,7 @@ test menuDraw-16.1 {TkPostSubmenu} {unixOnly} { $tearoff postcascade 0 list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} -test menuDraw-16.2 {TkPostSubMenu} {unixOnly} { +test menuDraw-16.2 {TkPostSubMenu} unix { catch {destroy .m1} catch {destroy .m2} catch {destroy .m3} @@ -461,7 +461,7 @@ test menuDraw-16.4 {TkPostSubMenu} { set tearoff [tk::TearOffMenu .m1 40 40] list [$tearoff postcascade 0] [destroy .m1] } {{} {}} -test menuDraw-16.5 {TkPostSubMenu} {unixOnly} { +test menuDraw-16.5 {TkPostSubMenu} unix { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -470,7 +470,7 @@ test menuDraw-16.5 {TkPostSubMenu} {unixOnly} { set tearoff [tk::TearOffMenu .m1 40 40] list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2] } {1 {invalid command name "glorp"} {} {}} -test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} { +test menuDraw-16.6 {TkPostSubMenu} {win userInteraction} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -481,7 +481,7 @@ test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} { list [$tearoff postcascade 0] [destroy .m1] [destroy .m2] } {{} {} {}} -test menuDraw-17.1 {AdjustMenuCoords - menubar} {unixOnly} { +test menuDraw-17.1 {AdjustMenuCoords - menubar} unix { catch {destroy .m1} catch {destroy .m2} menu .m1 -tearoff 0 @@ -496,7 +496,7 @@ test menuDraw-17.1 {AdjustMenuCoords - menubar} {unixOnly} { } list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2] } {{} {} {} {}} -test menuDraw-17.2 {AdjustMenuCoords - menu} {pcOnly userInteraction} { +test menuDraw-17.2 {AdjustMenuCoords - menu} {win userInteraction} { catch {destroy .m1} catch {destroy .m2} menu .m1 diff --git a/tests/menubut.test b/tests/menubut.test index 32039d5..7f4a210 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menubut.test,v 1.9 2004/05/23 17:34:48 dkf Exp $ +# RCS: @(#) $Id: menubut.test,v 1.10 2004/06/24 12:45:43 dkf Exp $ # XXX This test file is woefully incomplete right now. If any part # XXX of a procedure has tests then the whole procedure has tests, @@ -302,7 +302,7 @@ test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {nonPortable fonts} { pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {78 28} -test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {testImageType unixOnly nonPortable} { +test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {testImageType unix nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. @@ -312,7 +312,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {testImageType unixOn pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {64 23} -test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {testImageType pcOnly nonPortable} { +test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {testImageType win nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 9773b54..b85c020 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: scrollbar.test,v 1.13 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: scrollbar.test,v 1.14 2004/06/24 12:45:43 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -161,16 +161,16 @@ test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} { list [catch {.s cget -orient} msg] $msg } {0 vertical} scrollbar .s2 -test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} { +test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} win { list [catch {.s2 cget -bd} msg] $msg } {0 0} -test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {unixOnly} { +test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} unix { list [catch {.s2 cget -bd} msg] $msg } {0 2} -test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} { +test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} win { list [catch {.s2 cget -highlightthickness} msg] $msg } {0 0} -test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {unixOnly} { +test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} unix { list [catch {.s2 cget -highlightthickness} msg] $msg } {0 1} destroy .s2 @@ -249,16 +249,16 @@ test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} { .s fraction 4 21 } [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \ /([getTroughSize .s] - 1)]] -test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} { +test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} unix { .s fraction 4 179 } {1} test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} { .s fraction 4 [expr 200 - [testmetrics cyvscroll .s]] } {1} -test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} { +test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} unix { .s fraction 4 178 } {0.993711} -test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics pcOnly} { +test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics win} { expr [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s] - 2]] \ == [format %g [expr (200.0 - [testmetrics cyvscroll .s]*2 - 2) \ / ($height - 1 - [testmetrics cyvscroll .s]*2)]] @@ -326,7 +326,7 @@ test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} { test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} { .s identify 5 195 } {arrow2} -test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} {unixOnly} { +test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} unix { .s identify 0 0 } {} test scrollbar-3.57 {ScrollbarWidgetCmd procedure, "set" option} { @@ -423,16 +423,17 @@ scrollbar .s -orient vertical -relief sunken -bd 2 -highlightthickness 2 pack .s -side left -fill y .s set .2 .4 update -test scrollbar-6.1 {ScrollbarPosition procedure} {unixOnly} { + +test scrollbar-6.1 {ScrollbarPosition procedure} unix { .s identify 8 3 } {} -test scrollbar-6.3 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.3 {ScrollbarPosition procedure} unix { .s identify 8 196 } {} -test scrollbar-6.4 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.4 {ScrollbarPosition procedure} unix { .s identify 3 100 } {} -test scrollbar-6.6 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.6 {ScrollbarPosition procedure} unix { .s identify 19 100 } {} test scrollbar-6.7 {ScrollbarPosition procedure} { @@ -447,60 +448,56 @@ test scrollbar-6.9 {ScrollbarPosition procedure} { test scrollbar-6.10 {ScrollbarPosition procedure} { .s identify [winfo width .s] [expr [winfo height .s] / 2] } {} - -test scrollbar-6.11 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.11 {ScrollbarPosition procedure} unix { .s identify 8 4 } {arrow1} -test scrollbar-6.12 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.12 {ScrollbarPosition procedure} unix { .s identify 8 19 } {arrow1} -test scrollbar-6.14 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.14 {ScrollbarPosition procedure} win { .s identify [expr [winfo width .s] / 2] 0 } {arrow1} -test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll] - 1] } {arrow1} - -test scrollbar-6.16 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.16 {ScrollbarPosition procedure} unix { .s identify 8 20 } {trough1} -test scrollbar-6.17 {ScrollbarPosition procedure} {unixOnly nonPortable} { +test scrollbar-6.17 {ScrollbarPosition procedure} {unix nonPortable} { # Don't know why this is non-portable, but it doesn't work on # some platforms. .s identify 8 51 } {trough1} -test scrollbar-6.18 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.18 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [testmetrics cyvscroll] } {trough1} -test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.19 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \ + [testmetrics cyvscroll] - 1] } {trough1} - -test scrollbar-6.20 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.20 {ScrollbarPosition procedure} unix { .s identify 8 52 } {slider} -test scrollbar-6.21 {ScrollbarPosition procedure} {unixOnly nonPortable} { +test scrollbar-6.21 {ScrollbarPosition procedure} {unix nonPortable} { # Don't know why this is non-portable, but it doesn't work on # some platforms. .s identify 8 83 } {slider} -test scrollbar-6.22 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.22 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \ + [testmetrics cyvscroll]] } {slider} -test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.23 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ + [testmetrics cyvscroll] - 1] } {slider} - -test scrollbar-6.24 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.24 {ScrollbarPosition procedure} unix { .s identify 8 84 } {trough2} -test scrollbar-6.25 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.25 {ScrollbarPosition procedure} unix { .s identify 8 179 } {trough2} -test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics pcOnly knownBug} { +test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics win knownBug} { # This asks for 8,21, which is actually the slider, but there is a # bug in that GetSystemMetrics(SM_CYVTHUMB) actually returns a value # that is larger than the thumb displayed, skewing the ability to @@ -508,35 +505,33 @@ test scrollbar-6.27 {ScrollbarPosition procedure} {testmetrics pcOnly knownBug} .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \ + [testmetrics cyvscroll]] } {trough2} -test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ - [testmetrics cyvscroll] - 1] } {trough2} - -test scrollbar-6.29 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.29 {ScrollbarPosition procedure} unix { .s identify 8 180 } {arrow2} -test scrollbar-6.30 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.30 {ScrollbarPosition procedure} unix { .s identify 8 195 } {arrow2} -test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics win} { .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \ - [testmetrics cyvscroll]] } {arrow2} -test scrollbar-6.33 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.33 {ScrollbarPosition procedure} win { .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1] } {arrow2} - -test scrollbar-6.34 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.34 {ScrollbarPosition procedure} unix { .s identify 4 100 } {trough2} -test scrollbar-6.35 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.35 {ScrollbarPosition procedure} unix { .s identify 18 100 } {trough2} -test scrollbar-6.37 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.37 {ScrollbarPosition procedure} win { .s identify 0 100 } {trough2} -test scrollbar-6.38 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.38 {ScrollbarPosition procedure} win { .s identify [expr [winfo width .s] - 1] 100 } {trough2} @@ -547,23 +542,24 @@ scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2 place .t.s -width 200 .t.s set .2 .4 update -test scrollbar-6.39 {ScrollbarPosition procedure} {unixOnly} { + +test scrollbar-6.39 {ScrollbarPosition procedure} unix { .t.s identify 4 8 } {arrow1} -test scrollbar-6.40 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.40 {ScrollbarPosition procedure} win { .t.s identify 0 [expr [winfo height .t.s] / 2] } {arrow1} -test scrollbar-6.41 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.41 {ScrollbarPosition procedure} unix { .t.s identify 82 8 } {slider} -test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics pcOnly} { +test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics win} { .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll] \ - 1] [expr [winfo height .t.s] / 2] } {slider} -test scrollbar-6.44 {ScrollbarPosition procedure} {unixOnly} { +test scrollbar-6.44 {ScrollbarPosition procedure} unix { .t.s identify 100 18 } {trough2} -test scrollbar-6.46 {ScrollbarPosition procedure} {pcOnly} { +test scrollbar-6.46 {ScrollbarPosition procedure} win { .t.s identify 100 [expr [winfo height .t.s] - 1] } {trough2} diff --git a/tests/select.test b/tests/select.test index 1195661..10991b7 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.14 2004/06/04 19:55:31 dgp Exp $ +# RCS: @(#) $Id: select.test,v 1.15 2004/06/24 12:45:43 dkf Exp $ # # Note: Multiple display selection handling will only be tested if the @@ -129,13 +129,13 @@ test select-1.3 {Tk_CreateSelHandler procedure} { set selInfo "" list [selection get TEST] $selInfo } {{Test value} {TEST 0 4000}} -test select-1.4.1 {Tk_CreateSelHandler procedure} {unixOnly} { +test select-1.4.1 {Tk_CreateSelHandler procedure} unix { setup selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} lsort [selection get TARGETS] } {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} -test select-1.4.2 {Tk_CreateSelHandler procedure} {pcOnly} { +test select-1.4.2 {Tk_CreateSelHandler procedure} win { setup selection handle .f1 {handler TEST} TEST selection handle .f1 {handler STRING} @@ -150,7 +150,7 @@ test select-1.5 {Tk_CreateSelHandler procedure} { set selInfo "" list [selection get] $selInfo } {{} {STRING 0 4000}} -test select-1.6.1 {Tk_CreateSelHandler procedure} {unixOnly} { +test select-1.6.1 {Tk_CreateSelHandler procedure} unix { global selValue selInfo setup selection handle .f1 {handler TEST} TEST @@ -163,7 +163,7 @@ test select-1.6.1 {Tk_CreateSelHandler procedure} {unixOnly} { selection get -type TEST list [set selInfo] [lsort [selection get TARGETS]] } {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} -test select-1.6.2 {Tk_CreateSelHandler procedure} {pcOnly} { +test select-1.6.2 {Tk_CreateSelHandler procedure} win { global selValue selInfo setup selection handle .f1 {handler TEST} TEST @@ -176,7 +176,7 @@ test select-1.6.2 {Tk_CreateSelHandler procedure} {pcOnly} { selection get -type TEST list [set selInfo] [lsort [selection get TARGETS]] } {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-1.7.1 {Tk_CreateSelHandler procedure} {unixOnly} { +test select-1.7.1 {Tk_CreateSelHandler procedure} unix { setup selection own -selection CLIPBOARD .f1 selection handle -selection CLIPBOARD .f1 {handler TEST} TEST @@ -184,7 +184,7 @@ test select-1.7.1 {Tk_CreateSelHandler procedure} {unixOnly} { list [lsort [selection get -selection PRIMARY TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] } {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-1.7.2 {Tk_CreateSelHandler procedure} {pcOnly} { +test select-1.7.2 {Tk_CreateSelHandler procedure} win { setup selection own -selection CLIPBOARD .f1 selection handle -selection CLIPBOARD .f1 {handler TEST} TEST @@ -200,7 +200,7 @@ test select-1.8 {Tk_CreateSelHandler procedure} { ############################################################################## -test select-2.1 {Tk_DeleteSelHandler procedure} {unixOnly} { +test select-2.1 {Tk_DeleteSelHandler procedure} unix { setup selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -209,7 +209,7 @@ test select-2.1 {Tk_DeleteSelHandler procedure} {unixOnly} { selection handle -type TEST .f1 {} lappend result [lsort [selection get TARGETS]] } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING}} -test select-2.2 {Tk_DeleteSelHandler procedure} {unixOnly} { +test select-2.2 {Tk_DeleteSelHandler procedure} unix { setup selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -218,7 +218,7 @@ test select-2.2 {Tk_DeleteSelHandler procedure} {unixOnly} { selection handle -type USER .f1 {} lappend result [lsort [selection get TARGETS]] } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER UTF8_STRING} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING}} -test select-2.3 {Tk_DeleteSelHandler procedure} {unixOnly} { +test select-2.3 {Tk_DeleteSelHandler procedure} unix { setup selection own -selection CLIPBOARD .f1 selection handle -selection PRIMARY .f1 {handler STRING} @@ -227,7 +227,7 @@ test select-2.3 {Tk_DeleteSelHandler procedure} {unixOnly} { list [lsort [selection get TARGETS]] \ [lsort [selection get -selection CLIPBOARD TARGETS]] } {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW UTF8_STRING} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.4 {Tk_DeleteSelHandler procedure} {pcOnly} { +test select-2.4 {Tk_DeleteSelHandler procedure} win { setup selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -236,7 +236,7 @@ test select-2.4 {Tk_DeleteSelHandler procedure} {pcOnly} { selection handle -type TEST .f1 {} lappend result [lsort [selection get TARGETS]] } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}} -test select-2.5 {Tk_DeleteSelHandler procedure} {pcOnly} { +test select-2.5 {Tk_DeleteSelHandler procedure} win { setup selection handle .f1 {handler STRING} selection handle -type TEST .f1 {handler TEST} @@ -245,7 +245,7 @@ test select-2.5 {Tk_DeleteSelHandler procedure} {pcOnly} { selection handle -type USER .f1 {} lappend result [lsort [selection get TARGETS]] } {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-2.6 {Tk_DeleteSelHandler procedure} {pcOnly} { +test select-2.6 {Tk_DeleteSelHandler procedure} win { setup selection own -selection CLIPBOARD .f1 selection handle -selection PRIMARY .f1 {handler STRING} @@ -305,7 +305,7 @@ test select-3.6 {Tk_OwnSelection procedure} { selection clear .f1 lappend result $lostSel } {owned lost2} -test select-3.7 {Tk_OwnSelection procedure} {unixOnly} { +test select-3.7 {Tk_OwnSelection procedure} unix { global lostSel setup setupbg @@ -369,7 +369,7 @@ test select-4.3 {Tk_ClearSelection procedure} { setup list [selection clear .f1] [selection clear .f1] } {{} {}} -test select-4.4 {Tk_ClearSelection procedure} {unixOnly} { +test select-4.4 {Tk_ClearSelection procedure} unix { global lostSel setup setupbg @@ -397,7 +397,7 @@ test select-4.5 {Tk_ClearSelection procedure} {altDisplay} { update list $lostSel $lostSel2 } {owned lost2} -test select-4.6 {Tk_ClearSelection procedure} {unixOnly altDisplay} { +test select-4.6 {Tk_ClearSelection procedure} {unix altDisplay} { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) setupbg @@ -476,7 +476,7 @@ test select-5.8 {Tk_GetSelection procedure} { selection handle .f1 {weirdHandler STRING} list [selection get] $selInfo [catch {selection get} msg] $msg } "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}" -test select-5.9 {Tk_GetSelection procedure} {unixOnly} { +test select-5.9 {Tk_GetSelection procedure} unix { setup setupbg selection handle -selection PRIMARY .f1 {handler TEST} TEST @@ -488,7 +488,7 @@ test select-5.9 {Tk_GetSelection procedure} {unixOnly} { cleanupbg lappend result $selInfo } {{Test value} {TEST 0 4000}} -test select-5.10 {Tk_GetSelection procedure} {unixOnly} { +test select-5.10 {Tk_GetSelection procedure} unix { setup setupbg selection handle -selection PRIMARY .f1 {handler TEST} TEST @@ -530,7 +530,7 @@ test select-5.12 {Tk_GetSelection procedure} {altDisplay} { lappend result [catch {selection get -displayof .f2 TEST} msg] $msg \ $selInfo } {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection doesn't exist or form "TEST" not defined} {}} -test select-5.13 {Tk_GetSelection procedure} {unixOnly altDisplay} { +test select-5.13 {Tk_GetSelection procedure} {unix altDisplay} { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) setupbg @@ -548,7 +548,7 @@ test select-5.13 {Tk_GetSelection procedure} {unixOnly altDisplay} { cleanupbg lappend result $selInfo } {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}} -test select-5.14 {Tk_GetSelection procedure} {unixOnly altDisplay} { +test select-5.14 {Tk_GetSelection procedure} {unix altDisplay} { setup .f1 setup .f2 $env(TK_ALT_DISPLAY) setupbg @@ -780,7 +780,7 @@ test select-7.1 {TkSelDeadWindow procedure} nonPortable { # Check reentrancy on losing selection -test select-8.1 {TkSelEventProc procedure} -constraints unixOnly -setup { +test select-8.1 {TkSelEventProc procedure} -constraints unix -setup { setup setupbg } -body { @@ -796,7 +796,7 @@ test select-8.1 {TkSelEventProc procedure} -constraints unixOnly -setup { test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg -} -constraints unixOnly -body { +} -constraints unix -body { set selValue "1024" set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -807,7 +807,7 @@ test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup { cleanupbg lappend result $selInfo } -result {0x400 {TEST 0 4000}} -test select-9.2 {SelCvtToX and SelCvtFromX procedures} unixOnly { +test select-9.2 {SelCvtToX and SelCvtFromX procedures} unix { setup setupbg set selValue "1024 0xffff 2048 -2 " @@ -819,7 +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 { +test select-9.3 {SelCvtToX and SelCvtFromX procedures} unix { setup setupbg set selValue " " @@ -831,7 +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 { +test select-9.4 {SelCvtToX and SelCvtFromX procedures} unix { setup setupbg set selValue "16 foobar 32" @@ -849,7 +849,7 @@ test select-9.4 {SelCvtToX and SelCvtFromX procedures} unixOnly { # note, we are not testing MULTIPLE style selections # most control paths have been exercised above -test select-10.1 {ConvertSelection procedure, race with selection clear} {unixOnly} { +test select-10.1 {ConvertSelection procedure, race with selection clear} unix { setup proc Ready {fd} { variable x @@ -877,7 +877,7 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} {unixOn catch {close $fd} lappend x $selInfo } {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}} -test select-10.2 {ConvertSelection procedure} {unixOnly} { +test select-10.2 {ConvertSelection procedure} unix { setup setupbg set selValue [string range $longValue 0 3999] @@ -888,7 +888,7 @@ test select-10.2 {ConvertSelection procedure} {unixOnly} { cleanupbg lappend result $selInfo } [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}] -test select-10.3 {ConvertSelection procedure} {unixOnly} { +test select-10.3 {ConvertSelection procedure} unix { setup setupbg selection handle .f1 ERROR errHandler @@ -899,7 +899,7 @@ test select-10.3 {ConvertSelection procedure} {unixOnly} { } {{PRIMARY selection doesn't exist or form "ERROR" not defined}} # testing timers # This one hangs in Exceed -test select-10.4 {ConvertSelection procedure} {unixOnly noExceed} { +test select-10.4 {ConvertSelection procedure} {unix noExceed} { setup setupbg set selValue $longValue @@ -911,7 +911,7 @@ test select-10.4 {ConvertSelection procedure} {unixOnly noExceed} { cleanupbg lappend result $selInfo } {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}} -test select-10.5 {ConvertSelection procedure, reentrancy issues} {unixOnly} { +test select-10.5 {ConvertSelection procedure, reentrancy issues} unix { setup setupbg set selValue "Test value" @@ -923,7 +923,7 @@ test select-10.5 {ConvertSelection procedure, reentrancy issues} {unixOnly} { cleanupbg lappend result $selInfo } {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}} -test select-10.6 {ConvertSelection procedure, reentrancy issues} {unixOnly} { +test select-10.6 {ConvertSelection procedure, reentrancy issues} unix { proc weirdHandler {type offset count} { destroy .f1 handler $type $offset $count @@ -942,7 +942,7 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} {unixOnly} { ############################################################################## # testing reentrancy -test select-11.1 {TkSelPropProc procedure} {unixOnly} { +test select-11.1 {TkSelPropProc procedure} unix { setup setupbg set selValue $longValue @@ -959,7 +959,7 @@ test select-11.1 {TkSelPropProc procedure} {unixOnly} { ############################################################################## # Note, this assumes we are using CurrentTtime -test select-12.1 {DefaultSelection procedure} {unixOnly} { +test select-12.1 {DefaultSelection procedure} unix { setup set result [selection get -type TIMESTAMP] setupbg @@ -967,7 +967,7 @@ test select-12.1 {DefaultSelection procedure} {unixOnly} { cleanupbg set result } {0x0 0x0} -test select-12.2 {DefaultSelection procedure} {unixOnly} { +test select-12.2 {DefaultSelection procedure} unix { setup set result [lsort [list [selection get -type TARGETS]]] setupbg @@ -975,7 +975,7 @@ test select-12.2 {DefaultSelection procedure} {unixOnly} { cleanupbg set result } {{MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-12.3 {DefaultSelection procedure} {unixOnly} { +test select-12.3 {DefaultSelection procedure} unix { setup selection handle .f1 {handler TEST} TEST set result [list [lsort [selection get -type TARGETS]]] @@ -984,7 +984,7 @@ test select-12.3 {DefaultSelection procedure} {unixOnly} { cleanupbg set result } {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-12.4 {DefaultSelection procedure} {unixOnly} { +test select-12.4 {DefaultSelection procedure} unix { setup set result "" lappend result [selection get -type TK_APPLICATION] @@ -993,7 +993,7 @@ test select-12.4 {DefaultSelection procedure} {unixOnly} { cleanupbg set result } [list [winfo name .] [winfo name .]] -test select-12.5 {DefaultSelection procedure} {unixOnly} { +test select-12.5 {DefaultSelection procedure} unix { setup set result [selection get -type TK_WINDOW] setupbg @@ -1011,7 +1011,7 @@ test select-12.6 {DefaultSelection procedure} { lappend result [selection get TARGETS] } {{Targets value} {TARGETS.f1 0 4000} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test select-13.1 {SelectionSize procedure, handler deleted} {unixOnly} { +test select-13.1 {SelectionSize procedure, handler deleted} unix { proc badHandler {path type offset count} { global selValue selInfo abortCount incr abortCount -1 diff --git a/tests/spinbox.test b/tests/spinbox.test index 90f5df2..ca84c5c 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -4,7 +4,7 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: spinbox.test,v 1.8 2004/03/17 18:15:50 das Exp $ +# RCS: @(#) $Id: spinbox.test,v 1.9 2004/06/24 12:45:43 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -1133,26 +1133,26 @@ test spinbox-13.9 {GetSpinboxIndex procedure} { list [.e index sel.first] [.e index sel.last] } {1 6} selection clear .e -test spinbox-13.10 {GetSpinboxIndex procedure} {unixOnly} { +test spinbox-13.10 {GetSpinboxIndex procedure} unix { # On unix, when selection is cleared, spinbox widget's internal # selection range is reset. list [catch {.e index sel.first} msg] $msg } {1 {selection isn't in widget .e}} -test spinbox-13.11 {GetSpinboxIndex procedure} {pcOnly} { +test spinbox-13.11 {GetSpinboxIndex procedure} win { # On mac and pc, when selection is cleared, spinbox widget remembers # last selected range. When selection ownership is restored to # spinbox, the old range will be rehighlighted. list [catch {selection get}] [.e index sel.first] } {1 1} -test spinbox-13.12 {GetSpinboxIndex procedure} {unixOnly} { +test spinbox-13.12 {GetSpinboxIndex procedure} unix { list [catch {.e index sbogus} msg] $msg } {1 {selection isn't in widget .e}} -test spinbox-13.13 {GetSpinboxIndex procedure} {pcOnly} { +test spinbox-13.13 {GetSpinboxIndex procedure} win { list [catch {.e index sbogus} msg] $msg } {1 {bad spinbox index "sbogus"}} -test spinbox-13.14 {GetSpinboxIndex procedure} {pcOnly} { +test spinbox-13.14 {GetSpinboxIndex procedure} win { list [catch {selection get}] [catch {.e index sbogus}] } {1 1} test spinbox-13.15 {GetSpinboxIndex procedure} { diff --git a/tests/text.test b/tests/text.test index 16a6083..27c922c 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: text.test,v 1.30 2004/06/09 22:39:08 vincentdarley Exp $ +# RCS: @(#) $Id: text.test,v 1.31 2004/06/24 12:45:43 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -1252,7 +1252,7 @@ test text-18.5 {TextFetchSelection procedure, long selections} { selection get } $x\n -test text-19.1 {TkTextLostSelection procedure} {unixOnly} { +test text-19.1 {TkTextLostSelection procedure} unix { catch {destroy .t2} text .t2 .t2 insert 1.0 "abc\ndef\nghijk\n1234" @@ -1260,7 +1260,7 @@ test text-19.1 {TkTextLostSelection procedure} {unixOnly} { .t.e select to 1 .t2 tag ranges sel } {} -test text-19.2 {TkTextLostSelection procedure} {pcOnly} { +test text-19.2 {TkTextLostSelection procedure} win { catch {destroy .t2} text .t2 .t2 insert 1.0 "abc\ndef\nghijk\n1234" diff --git a/tests/textDisp.test b/tests/textDisp.test index 69d23d6..3ab4503 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: textDisp.test,v 1.27 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: textDisp.test,v 1.28 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -893,7 +893,7 @@ test textDisp-6.5 {scrolling in DisplayText, scroll source obscured} {nonPortabl destroy .f2 list $tk_textRelayout $tk_textRedraw } {{1.0 9.0 10.0} {1.0 4.0 5.0 9.0 10.0}} -test textDisp-6.6 {scrolling in DisplayText, Expose events after scroll} {unixOnly nonPortable} { +test textDisp-6.6 {scrolling in DisplayText, Expose events after scroll} {unix nonPortable} { # this test depends on all of the expose events being handled at once .t configure -wrap char frame .f2 -bg #ff0000 @@ -2760,7 +2760,7 @@ test textDisp-24.4 {TkTextCharLayoutProc, newline not visible} {textfonts} { update list [.t bbox 1.19] [.t bbox 1.20] [.t bbox 2.20] } [list [list 136 3 7 $fixedHeight] [list 143 3 0 $fixedHeight] [list 3 [expr {2*$fixedDiff + 29}] 7 $fixedHeight]] -test textDisp-24.5 {TkTextCharLayoutProc, char doesn't fit, newline not visible} {unixOnly textfonts} { +test textDisp-24.5 {TkTextCharLayoutProc, char doesn't fit, newline not visible} {unix textfonts} { .t configure -wrap char .t delete 1.0 end .t insert 1.0 0\n1\n @@ -3572,7 +3572,7 @@ test textDisp-33.4 {one line longer than fits in the widget} { set result } {ok} destroy .tt -test textDisp-33.5 {bold or italic fonts} {winOnly} { +test textDisp-33.5 {bold or italic fonts} {pc} { destroy .tt pack [text .tt -wrap char -font {{MS Sans Serif} 15}] font create no -family [lindex [.tt cget -font] 0] -size 24 diff --git a/tests/tk.test b/tests/tk.test index 7fd3af8..c2a781b 100644 --- a/tests/tk.test +++ b/tests/tk.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 2002 ActiveState Corporation. # -# RCS: @(#) $Id: tk.test,v 1.11 2004/03/17 18:15:50 das Exp $ +# RCS: @(#) $Id: tk.test,v 1.12 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -25,7 +25,7 @@ test tk-2.1 {tk command: appname} { test tk-2.2 {tk command: appname} { tk appname foobazgarply } {foobazgarply} -test tk-2.3 {tk command: appname} {unixOnly} { +test tk-2.3 {tk command: appname} unix { tk appname bazfoogarply expr {[lsearch -exact [winfo interps] [tk appname]] >= 0} } {1} @@ -94,7 +94,7 @@ test tk-4.4 {tk command: useinputmethods: set new} { test tk-4.5 {tk command: useinputmethods: set new} { list [catch {tk useinputmethods -displayof . xyz} msg] $msg } {1 {expected boolean value but got "xyz"}} -test tk-4.6 {tk command: useinputmethods: set new} {unixOnly} { +test tk-4.6 {tk command: useinputmethods: set new} unix { # This isn't really a test, but more of a check... # The answer is what was given, because we may be on a Unix # system that doesn't have the XIM stuff @@ -103,7 +103,7 @@ test tk-4.6 {tk command: useinputmethods: set new} {unixOnly} { } set useim } $useim -test tk-4.7 {tk command: useinputmethods: set new} {pcOnly} { +test tk-4.7 {tk command: useinputmethods: set new} win { # Mac and Windows don't have X Input Methods, so this should # always return 0 tk useinputmethods 1 diff --git a/tests/unixMenu.test b/tests/unixMenu.test index 457462e..6229d6f 100644 --- a/tests/unixMenu.test +++ b/tests/unixMenu.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixMenu.test,v 1.8 2003/04/01 21:06:56 dgp Exp $ +# RCS: @(#) $Id: unixMenu.test,v 1.9 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -819,7 +819,7 @@ test unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} unix { .m1 add separator list [update idletasks] [destroy .m1] } {{} {}} -test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} { +test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} unix { catch {destroy .m1} menubutton .mb -text "test" -menu .mb.m menu .mb.m @@ -892,7 +892,7 @@ test unixMenu-25.14 {TkpComputeStandardMenuGeometry - second indicator less or e .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unixOnly testImageType} { +test unixMenu-25.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unix testImageType} { catch {destroy .m1} catch {image delete image1} image create test image1 diff --git a/tests/unixSelect.test b/tests/unixSelect.test index c3516d3..78decc4 100644 --- a/tests/unixSelect.test +++ b/tests/unixSelect.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unixSelect.test,v 1.9 2003/04/01 21:06:57 dgp Exp $ +# RCS: @(#) $Id: unixSelect.test,v 1.10 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -106,7 +106,7 @@ foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} { append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j } -test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} {unixOnly} { +test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} unix { setupbg entry .e pack .e @@ -118,7 +118,7 @@ test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} {unixOnly} { destroy .e set result } {5} -test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} {unixOnly} { +test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} unix { setupbg dobg { entry .e; pack .e; update @@ -130,7 +130,7 @@ test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} { list [string equal \u00fc? $x] \ [string length $x] [string bytelength $x] } {1 2 3} -test unixSelect-1.4 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} { +test unixSelect-1.4 {TkSelGetSelection procedure: simple i18n text, iso2022} unix { setupbg setup selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ @@ -146,7 +146,7 @@ test unixSelect-1.4 {TkSelGetSelection procedure: simple i18n text, iso2022} {un cleanupbg lappend result $selInfo } {1 2 4 {COMPOUND_TEXT 0 4000}} -test unixSelect-1.5 {TkSelGetSelection procedure: INCR i18n text, iso2022} {unixOnly} { +test unixSelect-1.5 {TkSelGetSelection procedure: INCR i18n text, iso2022} unix { # This test is subtle. The selection ends up getting fetched twice by # Tk: once to compute the length, and again to actually send the data. @@ -169,7 +169,7 @@ test unixSelect-1.5 {TkSelGetSelection procedure: INCR i18n text, iso2022} {unix cleanupbg lappend result $selInfo } {1 8000 8002 {COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3999 COMPOUND_TEXT 7998 4000 COMPOUND_TEXT 0 4000 COMPOUND_TEXT 4000 3998 COMPOUND_TEXT 7997 4000}} -test unixSelect-1.6 {TkSelGetSelection procedure: simple i18n text, iso2022} {unixOnly} { +test unixSelect-1.6 {TkSelGetSelection procedure: simple i18n text, iso2022} unix { setupbg setup selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \ @@ -185,7 +185,7 @@ test unixSelect-1.6 {TkSelGetSelection procedure: simple i18n text, iso2022} {un cleanupbg lappend result $selInfo } {1 2 4 {COMPOUND_TEXT 0 4000}} -test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { +test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} unix { setupbg dobg "entry .e; pack .e; update .e insert 0 \[encoding convertfrom identity \\u00fcber\]$longValue @@ -194,7 +194,7 @@ test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { cleanupbg set result } [expr {5 + [string bytelength $longValue]}] -test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { +test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} unix { setupbg dobg { entry .e; pack .e; update @@ -206,7 +206,7 @@ test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { list [string equal [string repeat x 3999]\u00fc $x] \ [string length $x] [string bytelength $x] } {1 4000 4001} -test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { +test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} unix { setupbg dobg { entry .e; pack .e; update @@ -218,7 +218,7 @@ test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { list [string equal \u00fc[string repeat x 3999] $x] \ [string length $x] [string bytelength $x] } {1 4000 4001} -test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { +test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text} unix { setupbg dobg { entry .e; pack .e; update @@ -233,7 +233,7 @@ test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text} {unixOnly} { # Now some tests to make sure that the right thing is done when # transferring UTF8 selections, to prevent [Bug 614650] and its ilk # from rearing its ugly head again. -test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { +test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { setupbg dobg { entry .e; pack .e; update @@ -245,7 +245,7 @@ test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO list [string equal [string repeat x 3999]\u00fc $x] \ [string length $x] [string bytelength $x] } {1 4000 4001} -test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { +test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { setupbg dobg { entry .e; pack .e; update @@ -257,7 +257,7 @@ test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO list [string equal \u00fc[string repeat x 3999] $x] \ [string length $x] [string bytelength $x] } {1 4000 4001} -test unixSelect-1.13 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { +test unixSelect-1.13 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { setupbg dobg { entry .e; pack .e; update @@ -269,7 +269,7 @@ test unixSelect-1.13 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO list [string equal [string repeat x 3999]\u00fc[string repeat x 4000] $x] \ [string length $x] [string bytelength $x] } {1 8000 8001} -test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} {unixOnly} { +test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} unix { setupbg entry .e pack .e @@ -281,7 +281,7 @@ test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} {uni destroy .e set result } {5} -test unixSelect-1.15 {TkSelGetSelection procedure: simple i18n text, utf-8} {unixOnly} { +test unixSelect-1.15 {TkSelGetSelection procedure: simple i18n text, utf-8} unix { setupbg dobg { entry .e; pack .e; update @@ -293,7 +293,7 @@ test unixSelect-1.15 {TkSelGetSelection procedure: simple i18n text, utf-8} {uni list [string equal \u00fc\u0444 $x] \ [string length $x] [string bytelength $x] } {1 2 4} -test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { +test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { setupbg dobg { entry .e; pack .e; update @@ -305,7 +305,7 @@ test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO list [string equal [string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ [string length $x] [string bytelength $x] } {1 2121 4221} -test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { +test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { setupbg dobg { entry .e; pack .e; update @@ -317,7 +317,7 @@ test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO list [string equal i[string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ [string length $x] [string bytelength $x] } {1 2122 4222} -test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { +test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { setupbg dobg { text .t; pack .t; update @@ -331,7 +331,7 @@ test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO list [string equal [string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ [string length $x] [string bytelength $x] } {1 2121 4221} -test unixSelect-1.19 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixOnly} { +test unixSelect-1.19 {TkSelGetSelection procedure: INCR i18n text, utf-8} unix { setupbg dobg { text .t; pack .t; update @@ -345,7 +345,7 @@ test unixSelect-1.19 {TkSelGetSelection procedure: INCR i18n text, utf-8} {unixO list [string equal i[string repeat [string repeat \u00c4\u00e4 50]\n 21] $x] \ [string length $x] [string bytelength $x] } {1 2122 4222} -test unixSelect-1.20 {Automatic UTF8_STRING support for selection handle} {unixOnly} { +test unixSelect-1.20 {Automatic UTF8_STRING support for selection handle} unix { # See Bug #666346 "Selection handling crashes under KDE 3.0" label .l selection handle .l [list handler STRING] diff --git a/tests/unixWm.test b/tests/unixWm.test index 05f0bb5..32d3c76 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixWm.test,v 1.38 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: unixWm.test,v 1.39 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.2 eval tcltest::configure $argv @@ -691,7 +691,7 @@ test unixWm-19.5 {Tk_WmCmd procedure, "geometry" option} {unix nonPortable} { update lappend result [wm geometry .t] } {150x300+5+6 100x50+5+6} -test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} {unix} { +test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} unix { list [catch {wm geometry .t qrs} msg] $msg } {1 {bad geometry specifier "qrs"}} diff --git a/tests/winButton.test b/tests/winButton.test index 80149b4..8914023 100644 --- a/tests/winButton.test +++ b/tests/winButton.test @@ -8,7 +8,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winButton.test,v 1.10 2003/04/01 21:07:00 dgp Exp $ +# RCS: @(#) $Id: winButton.test,v 1.11 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -31,7 +31,7 @@ radiobutton .r -text Radiobutton pack .l .b .c .r update -test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType pcOnly} { +test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType win} { deleteWindows image create test image1 image1 changed 0 0 0 0 60 40 @@ -48,7 +48,7 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType pcOnly} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {68 48 70 50 90 52 90 52} -test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} { +test winbutton-1.2 {TkpComputeButtonGeometry procedure} win { deleteWindows label .b1 -bitmap question -bd 3 -padx 0 -pady 2 button .b2 -bitmap question -bd 3 -padx 0 -pady 2 @@ -63,7 +63,7 @@ test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {23 33 25 35 45 37 45 37} -test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} { +test winbutton-1.3 {TkpComputeButtonGeometry procedure} win { deleteWindows label .b1 -bitmap question -bd 3 -highlightthickness 4 button .b2 -bitmap question -bd 3 -highlightthickness 0 @@ -79,7 +79,7 @@ test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {31 41 23 33 27 37 27 37} -test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { +test winbutton-1.4 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} @@ -92,21 +92,21 @@ test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {58 24 67 33 88 30 90 28} -test winbutton-1.5 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { +test winbutton-1.5 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0 pack .l1 update list [winfo reqwidth .l1] [winfo reqheight .l1] } {178 84} -test winbutton-1.6 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { +test winbutton-1.6 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0 pack .l1 update list [winfo reqwidth .l1] [winfo reqheight .l1] } {222 52} -test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { +test winbutton-1.7 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5 @@ -119,7 +119,7 @@ test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {74 24 67 97 174 46 64 28} -test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { +test winbutton-1.8 {TkpComputeButtonGeometry procedure} {win nonPortable} { deleteWindows label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \ -highlightthickness 4 @@ -135,7 +135,7 @@ test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { [winfo reqwidth .b3] [winfo reqheight .b3] \ [winfo reqwidth .b4] [winfo reqheight .b4] } {66 32 65 31 69 31 71 29} -test winbutton-1.9 {TkpComputeButtonGeometry procedure} {pcOnly} { +test winbutton-1.9 {TkpComputeButtonGeometry procedure} win { deleteWindows button .b2 -bitmap question -default normal list [winfo reqwidth .b2] [winfo reqheight .b2] diff --git a/tests/winClipboard.test b/tests/winClipboard.test index 7efe94e..7a710fd 100644 --- a/tests/winClipboard.test +++ b/tests/winClipboard.test @@ -10,7 +10,7 @@ # Copyright (c) 1998-2000 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winClipboard.test,v 1.13 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: winClipboard.test,v 1.14 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -19,19 +19,19 @@ tcltest::loadTestedCommands # Note that these tests may fail if another application is grabbing the # clipboard (e.g. an X server) -test winClipboard-1.1 {TkSelGetSelection} {pcOnly} { +test winClipboard-1.1 {TkSelGetSelection} win { clipboard clear catch {selection get -selection CLIPBOARD} msg set msg } {CLIPBOARD selection doesn't exist or form "STRING" not defined} -test winClipboard-1.2 {TkSelGetSelection} {pcOnly testclipboard} { +test winClipboard-1.2 {TkSelGetSelection} {win testclipboard} { clipboard clear clipboard append {} catch {selection get -selection CLIPBOARD} r1 catch {testclipboard} r2 list $r1 $r2 } {{} {}} -test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testclipboard} { +test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { clipboard clear clipboard append abcd update @@ -39,14 +39,14 @@ test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testcli catch {testclipboard} r2 list $r1 $r2 } {abcd abcd} -test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testclipboard} { +test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { clipboard clear clipboard append "line 1\nline 2" catch {selection get -selection CLIPBOARD} r1 catch {testclipboard} r2 list $r1 $r2 } [list "line 1\nline 2" "line 1\r\nline 2"] -test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testclipboard} { +test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {win testclipboard} { clipboard clear clipboard append "line 1\u00c7\nline 2" catch {selection get -selection CLIPBOARD} r1 @@ -54,7 +54,7 @@ test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testcli list $r1 $r2 } [list "line 1\u00c7\nline 2" [bytestring "line 1\u00c7\r\nline 2"]] -test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly testclipboard} { +test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {win testclipboard} { clipboard clear clipboard append -type OUR_ACTION "action data" clipboard append "string data" @@ -63,7 +63,7 @@ test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly testclip catch {testclipboard} r2 list $r1 $r2 } [list "action data" "string data"] -test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {pcOnly testclipboard} { +test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {win testclipboard} { clipboard clear clipboard append -type OUR_ACTION "new data" clipboard append "more data in string" diff --git a/tests/winFont.test b/tests/winFont.test index 6104e52..eec223e 100644 --- a/tests/winFont.test +++ b/tests/winFont.test @@ -10,7 +10,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winFont.test,v 1.9 2003/04/01 21:07:01 dgp Exp $ +# RCS: @(#) $Id: winFont.test,v 1.10 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -41,10 +41,10 @@ proc getsize {} { return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" } -test winfont-1.1 {TkpGetNativeFont procedure: not native} {pcOnly} { +test winfont-1.1 {TkpGetNativeFont procedure: not native} win { list [catch {font measure {} xyz} msg] $msg } {1 {font "" doesn't exist}} -test winfont-1.2 {TkpGetNativeFont procedure: native} {pcOnly} { +test winfont-1.2 {TkpGetNativeFont procedure: native} win { font measure ansifixed 0 font measure ansi 0 font measure device 0 @@ -54,99 +54,99 @@ test winfont-1.2 {TkpGetNativeFont procedure: native} {pcOnly} { set x {} } {} -test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} { +test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} win { expr [font actual {-size -10} -size]>0 } {1} -test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} { +test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} win { expr [font actual {-family Arial} -size]>0 } {1} -test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {pcOnly} { +test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} win { font actual {-weight normal} -weight } {normal} -test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {pcOnly} { +test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} win { font actual {-weight bold} -weight } {bold} -test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {pcOnly} { +test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} win { catch {expr {[font actual {-size 10} -size]}} } 0 -test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {pcOnly} { +test winfont-2.6 {TkpGetFontFromAttributes procedure: family} win { font actual {-family Arial} -family } {Arial} -test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {pcOnly} { +test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} win { set x {} lappend x [font actual {-family "Times"} -family] lappend x [font actual {-family "New York"} -family] lappend x [font actual {-family "Times New Roman"} -family] } {{Times New Roman} {Times New Roman} {Times New Roman}} -test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {pcOnly} { +test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} win { set x {} lappend x [font actual {-family "Courier"} -family] lappend x [font actual {-family "Monaco"} -family] lappend x [font actual {-family "Courier New"} -family] } {{Courier New} {Courier New} {Courier New}} -test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {pcOnly} { +test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} win { set x {} lappend x [font actual {-family "Helvetica"} -family] lappend x [font actual {-family "Geneva"} -family] lappend x [font actual {-family "Arial"} -family] } {Arial Arial Arial} -test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {pcOnly} { +test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} win { # No way to get it to fail! Any font name is acceptable. } {} -test winfont-3.1 {TkpDeleteFont procedure} {pcOnly} { +test winfont-3.1 {TkpDeleteFont procedure} win { font actual {-family xyz} set x {} } {} -test winfont-4.1 {TkpGetFontFamilies procedure} {pcOnly} { +test winfont-4.1 {TkpGetFontFamilies procedure} win { font families set x {} } {} -test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {pcOnly} { +test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} win { .b.l config -wrap 0 -text "000000" getsize } "[expr $ax*6] $ay" -test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {pcOnly} { +test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} win { .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" getsize } "[expr $ax*256] $ay" -test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {pcOnly} { +test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} win { .b.l config -wrap [expr $ax*10] -text "00000000" getsize } "[expr $ax*8] $ay" -test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {pcOnly} { +test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} win { .b.l config -wrap [expr $ax*6] -text "00000000" getsize } "[expr $ax*6] [expr $ay*2]" -test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {pcOnly} { +test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} win { .b.c dchars $t 0 end .b.c insert $t 0 "0000" .b.c index $t @[expr int($cx*2.5)],1 } {2} -test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} {pcOnly} { +test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} win { .b.l config -text "000000" -wrap 1 getsize } "$ax [expr $ay*6]" -test winfont-5.7 {Tk_MeasureChars procedure: whole words} {pcOnly} { +test winfont-5.7 {Tk_MeasureChars procedure: whole words} win { .b.l config -wrap [expr $ax*8] -text "000000 0000" getsize } "[expr $ax*6] [expr $ay*2]" -test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {pcOnly} { +test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} win { .b.l config -wrap [expr $ax*12] -text "000000 0000000" getsize } "[expr $ax*7] [expr $ay*2]" -test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {pcOnly} { +test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} win { .b.l config -wrap [expr $ax*12] -text "000 00 00000" getsize } "[expr $ax*7] [expr $ay*2]" -test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {pcOnly} { +test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} win { .b.l config -wrap [expr $ax*12] -text "0000000000000000" getsize } "[expr $ax*12] [expr $ay*2]" test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} \ - {pcOnly nonPortable} { + {win nonPortable} { set font [.b.l cget -font] .b.l config -font {{MS Sans Serif} 8} -text "W" set width [winfo reqwidth .b.l] @@ -155,12 +155,12 @@ test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} \ .b.l config -font $font expr $x < ($width*10) } 1 -test winfont-6.1 {Tk_DrawChars procedure: loop test} {pcOnly} { +test winfont-6.1 {Tk_DrawChars procedure: loop test} win { .b.l config -text "a" update } {} -test winfont-7.1 {AllocFont procedure: use old font} {pcOnly} { +test winfont-7.1 {AllocFont procedure: use old font} win { font create xyz catch {destroy .c} button .c -font xyz @@ -169,13 +169,13 @@ test winfont-7.1 {AllocFont procedure: use old font} {pcOnly} { destroy .c font delete xyz } {} -test winfont-7.2 {AllocFont procedure: extract info from logfont} {pcOnly} { +test winfont-7.2 {AllocFont procedure: extract info from logfont} win { font actual {arial 10 bold italic underline overstrike} } {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1} -test winfont-7.3 {AllocFont procedure: extract info from textmetric} {pcOnly} { +test winfont-7.3 {AllocFont procedure: extract info from textmetric} win { font metric {arial 10 bold italic underline overstrike} -fixed } {0} -test winfont-7.4 {AllocFont procedure: extract info from textmetric} {pcOnly} { +test winfont-7.4 {AllocFont procedure: extract info from textmetric} win { font metric systemfixed -fixed } {1} diff --git a/tests/winMenu.test b/tests/winMenu.test index 0c56507..01ed0c5 100644 --- a/tests/winMenu.test +++ b/tests/winMenu.test @@ -7,29 +7,29 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winMenu.test,v 1.8 2004/05/23 17:34:49 dkf Exp $ +# RCS: @(#) $Id: winMenu.test,v 1.9 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands -test winMenu-1.1 {GetNewID} {pcOnly} { +test winMenu-1.1 {GetNewID} win { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} # Basically impossible to test menu IDs wrapping. -test winMenu-2.1 {FreeID} {pcOnly} { +test winMenu-2.1 {FreeID} win { catch {destroy .m1} menu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} -test winMenu-3.1 {TkpNewMenu} {pcOnly} { +test winMenu-3.1 {TkpNewMenu} win { catch {destroy .m1} list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2 } {0 .m1 0 {}} -test winMenu-3.2 {TkpNewMenu} {pcOnly} { +test winMenu-3.2 {TkpNewMenu} win { catch {destroy .m1} . configure -menu "" menu .m1 @@ -37,12 +37,12 @@ test winMenu-3.2 {TkpNewMenu} {pcOnly} { list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2 } {0 {} {} 0 {}} -test winMenu-4.1 {TkpDestroyMenu} {pcOnly} { +test winMenu-4.1 {TkpDestroyMenu} win { catch {destroy .m1} menu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} -test winMenu-4.2 {TkpDestroyMenu - help menu} {pcOnly} { +test winMenu-4.2 {TkpDestroyMenu - help menu} win { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.system @@ -50,7 +50,7 @@ test winMenu-4.2 {TkpDestroyMenu - help menu} {pcOnly} { list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-5.1 {TkpDestroyMenuEntry} {pcOnly} { +test winMenu-5.1 {TkpDestroyMenuEntry} win { catch {destroy .m1} . configure -menu "" menu .m1 @@ -59,89 +59,89 @@ test winMenu-5.1 {TkpDestroyMenuEntry} {pcOnly} { list [catch {.m1 delete 1} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.1 {GetEntryText} {pcOnly} { +test winMenu-6.1 {GetEntryText} win { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} -test winMenu-6.2 {GetEntryText} {testImageType pcOnly} { +test winMenu-6.2 {GetEntryText} {testImageType win} { catch {destroy .m1} catch {image delete image1} menu .m1 image create test image1 list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1] } {0 {} {} {}} -test winMenu-6.3 {GetEntryText} {pcOnly} { +test winMenu-6.3 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.4 {GetEntryText} {pcOnly} { +test winMenu-6.4 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.5 {GetEntryText} {pcOnly} { +test winMenu-6.5 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.6 {GetEntryText} {pcOnly} { +test winMenu-6.6 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.7 {GetEntryText} {pcOnly} { +test winMenu-6.7 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.8 {GetEntryText} {pcOnly} { +test winMenu-6.8 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.9 {GetEntryText} {pcOnly} { +test winMenu-6.9 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.10 {GetEntryText} {pcOnly} { +test winMenu-6.10 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "This string has one & in it" -accel "bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.11 {GetEntryText} {pcOnly} { +test winMenu-6.11 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.12 {GetEntryText} {pcOnly} { +test winMenu-6.12 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.13 {GetEntryText} {pcOnly} { +test winMenu-6.13 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.14 {GetEntryText} {pcOnly} { +test winMenu-6.14 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "This string has one & in it" -accel "&bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.15 {GetEntryText} {pcOnly} { +test winMenu-6.15 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-6.16 {GetEntryText} {pcOnly} { +test winMenu-6.16 {GetEntryText} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {pcOnly} { +test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} win { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.system @@ -151,7 +151,7 @@ test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {pcOnly} { .m1.system add command -label bar list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {pcOnly} { +test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} win { catch {destroy .m1} menu .m1 .m1 add command -label Hello @@ -159,77 +159,77 @@ test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {pcOnly} { .m1 add command -label foo list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.3 {ReconfigureWindowsMenu - zero items} {pcOnly} { +test winMenu-7.3 {ReconfigureWindowsMenu - zero items} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label Hello .m1 delete Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.4 {ReconfigureWindowsMenu - one item} {pcOnly} { +test winMenu-7.4 {ReconfigureWindowsMenu - one item} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.5 {ReconfigureWindowsMenu - two items} {pcOnly} { +test winMenu-7.5 {ReconfigureWindowsMenu - two items} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label One .m1 add command -label Two list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.6 {ReconfigureWindowsMenu - separator item} {pcOnly} { +test winMenu-7.6 {ReconfigureWindowsMenu - separator item} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add separator list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} {pcOnly} { +test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} {pcOnly} { +test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label Hello -state disabled list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} {pcOnly} { +test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add checkbutton -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} {pcOnly} { +test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add radiobutton -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} {pcOnly} { +test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add checkbutton -label Hello .m1 invoke Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} {pcOnly} { +test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add radiobutton -label Hello .m1 invoke Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} {pcOnly} { +test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {pcOnly} { +test winMenu-7.14 {ReconfigureWindowsMenu - cascade} win { catch {destroy .m1} catch {destroy .m2} menu .m1 -tearoff 0 @@ -237,7 +237,7 @@ test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {pcOnly} { .m1 add cascade -menu .m2 -label Hello list [catch {update idletasks} msg] $msg [destroy .m1] [destroy .m2] } {0 {} {} {}} -test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {pcOnly} { +test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.file @@ -245,7 +245,7 @@ test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {pcOnly . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {pcOnly} { +test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system @@ -255,7 +255,7 @@ test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {pcOnly .m1.system add command -label Hello list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {pcOnly} { +test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system @@ -263,7 +263,7 @@ test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {pcOnly} . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {pcOnly} { +test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.system @@ -273,7 +273,7 @@ test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {pcO . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-7.19 {ReconfigureWindowsMenu - column break} {pcOnly} { +test winMenu-7.19 {ReconfigureWindowsMenu - column break} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one @@ -282,23 +282,23 @@ test winMenu-7.19 {ReconfigureWindowsMenu - column break} {pcOnly} { } {0 {} {}} #Don't know how to generate nested post menus -test winMenu-8.1 {TkpPostMenu} {pcOnly} { +test winMenu-8.1 {TkpPostMenu} win { catch {destroy .m1} menu .m1 -postcommand "blork" list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {1 {invalid command name "blork"} {}} -test winMenu-8.2 {TkpPostMenu} {pcOnly} { +test winMenu-8.2 {TkpPostMenu} win { catch {destroy .m1} menu .m1 -postcommand "destroy .m1" list [.m1 post 40 40] [winfo exists .m1] } {{} 0} -test winMenu-8.3 {TkpPostMenu - popup menu} {pcOnly userInteraction} { +test winMenu-8.3 {TkpPostMenu - popup menu} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-8.3: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-8.4 {TkpPostMenu - menu button} {pcOnly userInteraction} { +test winMenu-8.4 {TkpPostMenu - menu button} {win userInteraction} { catch {destroy .mb} menubutton .mb -text test -menu .mb.menu menu .mb.menu @@ -306,7 +306,7 @@ test winMenu-8.4 {TkpPostMenu - menu button} {pcOnly userInteraction} { pack .mb list [tk::MbPost .mb] [destroy .m1] } {{} {}} -test winMenu-8.5 {TkpPostMenu - update not pending} {pcOnly userInteraction} { +test winMenu-8.5 {TkpPostMenu - update not pending} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-8.5 - Hit ESCAPE." @@ -314,13 +314,13 @@ test winMenu-8.5 {TkpPostMenu - update not pending} {pcOnly userInteraction} { list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-9.1 {TkpMenuNewEntry} {pcOnly} { +test winMenu-9.1 {TkpMenuNewEntry} win { catch {destroy .m1} menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-10.1 {TkwinMenuProc} {pcOnly userInteraction} { +test winMenu-10.1 {TkwinMenuProc} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-10.1: Hit ESCAPE." @@ -328,21 +328,21 @@ test winMenu-10.1 {TkwinMenuProc} {pcOnly userInteraction} { } {{} {}} # Can't generate a WM_INITMENU without a Tk menu yet. -test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {pcOnly userInteraction} { +test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {win userInteraction} { catch {destroy .m1} catch {unset foo} menu .m1 -postcommand "set foo test" .m1 add command -label "winMenu-11.1: Hit ESCAPE." list [.m1 post 40 40] [set foo] [unset foo] [destroy .m1] } {test test {} {}} -test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} { +test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {win userInteraction} { catch {destroy .m1} catch {unset foo} menu .m1 .m1 add checkbutton -variable foo -label "winMenu-11.2: Please select this menu item." list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1] } {{} {} 1 {} {}} -test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} { +test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} {win userInteraction} { catch {destroy .m1} catch {unset foo} proc bgerror {args} { @@ -358,33 +358,33 @@ test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} { (menu invoke)}} {} {}} # Can't test WM_MENUCHAR -test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} { +test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-11.3: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} { +test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label "winMenu-11.4: Hit ESCAPE" -hidemargin 1 list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} {pcOnly userInteraction} { +test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-11.5: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} test winMenu-11.7 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} \ - {pcOnly userInteraction} { + {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-11.6: Hit ESCAPE." -state disabled list [.m1 post 40 40] [destroy .m1] } {{} {}} test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} \ - {pcOnly userInteraction} { + {win userInteraction} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label "winMenu-11.7: Hit ESCAPE" @@ -392,14 +392,14 @@ test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} \ list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-12.1 {TkpSetWindowMenuBar} {pcOnly} { +test winMenu-12.1 {TkpSetWindowMenuBar} win { catch {destroy .m1} . configure -menu "" menu .m1 .m1 add command -label foo list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2 } {0 {} {} 0 {}} -test winMenu-12.2 {TkpSetWindowMenuBar} {pcOnly} { +test winMenu-12.2 {TkpSetWindowMenuBar} win { catch {destroy .m1} . configure -menu "" menu .m1 @@ -407,7 +407,7 @@ test winMenu-12.2 {TkpSetWindowMenuBar} {pcOnly} { . configure -menu .m1 list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2 } {0 {} 0 {}} -test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {pcOnly} { +test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} win { catch {destroy .m1} . configure -menu "" menu .m1 -tearoff 0 @@ -416,48 +416,48 @@ test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {pcOnly} { list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest pcOnly} {} {} +test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest win} {} {} -test winMenu-14.1 {GetMenuIndicatorGeometry} {pcOnly} { +test winMenu-14.1 {GetMenuIndicatorGeometry} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-14.2 {GetMenuIndicatorGeometry} {pcOnly} { +test winMenu-14.2 {GetMenuIndicatorGeometry} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -hidemargin 1 list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-15.1 {GetMenuAccelGeometry} {pcOnly} { +test winMenu-15.1 {GetMenuAccelGeometry} win { catch {destroy .m1} menu .m1 .m1 add cascade -label foo -accel Ctrl+U list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-15.2 {GetMenuAccelGeometry} {pcOnly} { +test winMenu-15.2 {GetMenuAccelGeometry} win { catch {destroy .m1} menu .m1 .m1 add command -label foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-15.3 {GetMenuAccelGeometry} {pcOnly} { +test winMenu-15.3 {GetMenuAccelGeometry} win { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test winMenu-16.1 {GetTearoffEntryGeometry} {pcOnly userInteraction} { +test winMenu-16.1 {GetTearoffEntryGeometry} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-19.1: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-17.1 {GetMenuSeparatorGeometry} {pcOnly} { +test winMenu-17.1 {GetMenuSeparatorGeometry} win { catch {destroy .m1} menu .m1 .m1 add separator @@ -466,7 +466,7 @@ test winMenu-17.1 {GetMenuSeparatorGeometry} {pcOnly} { # Currently, the only callers to DrawWindowsSystemBitmap want things # centered vertically, and either centered or right aligned horizontally. -test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {pcOnly} { +test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -474,7 +474,7 @@ test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {pcOnly} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {pcOnly} { +test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} win { catch {destroy .m1} menu .m1 .m1 add cascade -label foo @@ -483,21 +483,21 @@ test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {pcOnly} { } {{} {}} test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \ - {pcOnly} { + win { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {pcOnly} { +test winMenu-19.2 {DrawMenuEntryIndicator - not selected} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} { +test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -505,7 +505,7 @@ test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} { +test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} win { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo @@ -513,7 +513,7 @@ test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} { +test winMenu-19.5 {DrawMenuEntryIndicator - disabled} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -522,7 +522,7 @@ test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} { +test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -indicatoron 0 @@ -531,29 +531,28 @@ test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} { list [update] [destroy .m1] } {{} {}} -test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {pcOnly} { +test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} win { catch {destroy .m1} menu .m1 -disabledforeground red .m1 add command -label foo -accel "Ctrl+U" -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {pcOnly} { +test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} win { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+U" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} \ - {pcOnly} { +test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} win { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -accel "Ctrl+U" -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {pcOnly} { +test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} win { catch {destroy .m1} menu .m1 .m1 add cascade -label foo @@ -561,14 +560,14 @@ test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {pcOnly} list [update] [destroy .m1] } {{} {}} test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} \ - {pcOnly userInteraction} { + {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add cascade -label "winMenu-23.5: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-21.1 {DrawMenuSeparator} {pcOnly} { +test winMenu-21.1 {DrawMenuSeparator} win { catch {destroy .m1} menu .m1 .m1 add separator @@ -576,7 +575,7 @@ test winMenu-21.1 {DrawMenuSeparator} {pcOnly} { list [update] [destroy .m1] } {{} {}} -test winMenu-22.1 {DrawMenuUnderline} {pcOnly} { +test winMenu-22.1 {DrawMenuUnderline} win { catch {destroy .m1} menu .m1 .m1 add command -label foo -underline 0 @@ -585,25 +584,25 @@ test winMenu-22.1 {DrawMenuUnderline} {pcOnly} { } {{} {}} test winMenu-23.1 {Don't know how to test MenuKeyBindProc} \ - {pcOnly emptyTest} {} {} + {win emptyTest} {} {} test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} \ - {pcOnly emptyTest} {} {} + {win emptyTest} {} {} -test winMenu-25.1 {DrawMenuEntryLabel - normal} {pcOnly} { +test winMenu-25.1 {DrawMenuEntryLabel - normal} win { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {pcOnly} { +test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} win { catch {destroy .m1} menu .m1 -disabledforeground red .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {pcOnly} { +test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} win { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled @@ -611,27 +610,27 @@ test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {pcOnly} { list [update] [destroy .m1] } {{} {}} -test winMenu-26.1 {TkpComputeMenubarGeometry} {pcOnly} { +test winMenu-26.1 {TkpComputeMenubarGeometry} win { catch {destroy .m1} menu .m1 .m1 add cascade -label File list [. configure -menu .m1] [. configure -menu ""] [destroy .m1] } {{} {} {}} -test winMenu-27.1 {DrawTearoffEntry} {pcOnly userInteraction} { +test winMenu-27.1 {DrawTearoffEntry} {win userInteraction} { catch {destroy .m1} menu .m1 .m1 add command -label "winMenu-24.4: Hit ESCAPE." list [.m1 post 40 40] [destroy .m1] } {{} {}} -test winMenu-28.1 {TkpConfigureMenuEntry - update pending} {pcOnly} { +test winMenu-28.1 {TkpConfigureMenuEntry - update pending} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label Hello list [catch {.m1 add command -label Two} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {pcOnly} { +test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label One @@ -639,8 +638,7 @@ test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {pcOnly} { list [catch {.m1 add command -label Two} msg] $msg [destroy .m1] } {0 {} {}} -test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} \ - {pcOnly} { +test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} win { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -648,8 +646,7 @@ test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} \ .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} \ - {pcOnly} { +test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} win { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground red @@ -657,7 +654,7 @@ test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} \ .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {pcOnly} { +test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} win { catch {destroy .m1} menu .m1 set tk_strictMotif 1 @@ -668,42 +665,42 @@ test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {pcOnly} { } {{} {} 0} test winMenu-29.4 \ {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} \ - {pcOnly} { + win { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled -background red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {pcOnly} { +test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} win { catch {destroy .m1} menu .m1 -disabledforeground blue .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {pcOnly} { +test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} win { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label foo -state disabled set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {pcOnly} { +test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} win { catch {destroy .m1} menu .m1 .m1 add command -label foo -foreground red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {pcOnly} { +test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} win { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} { +test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -selectcolor orange @@ -711,7 +708,7 @@ test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} { +test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -719,7 +716,7 @@ test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {pcOnly} { +test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} win { catch {destroy .m1} menu .m1 .m1 add command -label foo -activebackground green @@ -727,7 +724,7 @@ test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {pcOnly} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.12 {TkpDrawMenuEntry - border} {pcOnly} { +test winMenu-29.12 {TkpDrawMenuEntry - border} win { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -735,7 +732,7 @@ test winMenu-29.12 {TkpDrawMenuEntry - border} {pcOnly} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {pcOnly} { +test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} win { catch {destroy .m1} set tk_strictMotif 1 menu .m1 @@ -744,7 +741,7 @@ test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {pcOnly} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} -test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {pcOnly} { +test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} win { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground yellow @@ -752,7 +749,7 @@ test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {pcOnly} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.15 {TkpDrawMenuEntry - active border} {pcOnly} { +test winMenu-29.15 {TkpDrawMenuEntry - active border} win { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -760,35 +757,35 @@ test winMenu-29.15 {TkpDrawMenuEntry - active border} {pcOnly} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {pcOnly} { +test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} win { catch {destroy .m1} menu .m1 .m1 add command -label foo -font "Helvectica 72" set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.17 {TkpDrawMenuEntry - font} {pcOnly} { +test winMenu-29.17 {TkpDrawMenuEntry - font} win { catch {destroy .m1} menu .m1 -font "Courier 72" .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.18 {TkpDrawMenuEntry - separator} {pcOnly} { +test winMenu-29.18 {TkpDrawMenuEntry - separator} win { catch {destroy .m1} menu .m1 .m1 add separator set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.19 {TkpDrawMenuEntry - standard} {pcOnly} { +test winMenu-29.19 {TkpDrawMenuEntry - standard} win { catch {destroy .mb} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} { +test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} win { catch {destroy .m1} menu .m1 .m1 add cascade -label File -menu .m1.file @@ -798,7 +795,7 @@ test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} { +test winMenu-29.21 {TkpDrawMenuEntry - indicator} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label winMenu-31.20 @@ -806,7 +803,7 @@ test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} { +test winMenu-29.22 {TkpDrawMenuEntry - indicator} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label winMenu-31.21 -hidemargin 1 @@ -815,7 +812,7 @@ test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} { list [update] [destroy .m1] } {{} {}} -test winMenu-30.1 {GetMenuLabelGeometry - image} {testImageType pcOnly} { +test winMenu-30.1 {GetMenuLabelGeometry - image} {testImageType win} { catch {destroy .m1} catch {image delete image1} menu .m1 @@ -823,33 +820,33 @@ test winMenu-30.1 {GetMenuLabelGeometry - image} {testImageType pcOnly} { .m1 add command -image image1 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test winMenu-30.2 {GetMenuLabelGeometry - bitmap} {pcOnly} { +test winMenu-30.2 {GetMenuLabelGeometry - bitmap} win { catch {destroy .m1} menu .m1 .m1 add command -bitmap questhead list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-30.3 {GetMenuLabelGeometry - no text} {pcOnly} { +test winMenu-30.3 {GetMenuLabelGeometry - no text} win { catch {destroy .m1} menu .m1 .m1 add command list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-30.4 {GetMenuLabelGeometry - text} {pcOnly} { +test winMenu-30.4 {GetMenuLabelGeometry - text} win { catch {destroy .m1} menu .m1 .m1 add command -label "This is a test." list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-31.1 {DrawMenuEntryBackground} {pcOnly} { +test winMenu-31.1 {DrawMenuEntryBackground} win { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test winMenu-31.2 {DrawMenuEntryBackground} {pcOnly} { +test winMenu-31.2 {DrawMenuEntryBackground} win { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -858,31 +855,31 @@ test winMenu-31.2 {DrawMenuEntryBackground} {pcOnly} { list [update] [destroy .m1] } {{} {}} -test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} {pcOnly} { +test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} win { catch {destroy .m1} menu .m1 list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} {pcOnly} { +test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} win { catch {destroy .m1} menu .m1 .m1 add command -label "one" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} {pcOnly} { +test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} win { catch {destroy .m1} menu .m1 .m1 add command -label "one" .m1 add command -label "two" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} {pcOnly} { +test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} win { catch {destroy .m1} menu .m1 .m1 add separator list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} { +test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} unix { catch {destroy .m1} menubutton .mb -text "test" -menu .mb.m menu .mb.m @@ -892,55 +889,54 @@ test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} { list [update] [destroy .mb] } {{} {}} test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} \ - {pcOnly} { + win { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [update idletasks] [destroy .m1] } {{} {}} test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} \ - {pcOnly} { + win { catch {destroy .m1} menu .m1 -font "Helvetica 12" .m1 add command -label "test" -font "Courier 12" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} \ - {pcOnly} { +test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} win { catch {destroy .m1} menu .m1 .m1 add command -label "test" .m1 add command -label "test test" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} {pcOnly} { +test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} win { catch {destroy .m1} menu .m1 .m1 add command -label "test test" .m1 add command -label "test" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} {pcOnly} { +test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} win { catch {destroy .m1} menu .m1 .m1 add command -label "test" -accel "Ctrl+S" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} {pcOnly} { +test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} win { catch {destroy .m1} menu .m1 .m1 add command -label "test" -accel "1" .m1 add command -label "test" -accel "1 1" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} {pcOnly} { +test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} win { catch {destroy .m1} menu .m1 .m1 add command -label "test" -accel "1 1" .m1 add command -label "test" -accel "1" list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {pcOnly} { +test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} win { catch {destroy .m1} menu .m1 .m1 add checkbutton -label test @@ -949,7 +945,7 @@ test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {pcOnly} { } {{} {}} test winMenu-32.14 \ {TkpComputeStandardMenuGeometry - second indicator less or equal} \ - {testImageType pcOnly} { + {testImageType win} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -961,7 +957,7 @@ test winMenu-32.14 \ list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \ - {testImageType unixOnly} { + {testImageType unix} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -972,14 +968,12 @@ test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \ .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} \ - {pcOnly} { +test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} win { catch {destroy .m1} menu .m1 -tearoff 0 list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} \ - {pcOnly} { +test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} win { catch {destroy .m1} menu .m1 .m1 add command -label one @@ -988,7 +982,7 @@ test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} \ list [update idletasks] [destroy .m1] } {{} {}} test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \ - {pcOnly} { + win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one @@ -996,7 +990,7 @@ test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \ .m1 add command -label three list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {pcOnly} { +test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} win { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one @@ -1008,14 +1002,14 @@ test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {pcOnly} { list [update idletasks] [destroy .m1] } {{} {}} -test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} {pcOnly} { +test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} win { catch {destroy .t2} catch {destroy .m1} toplevel .t2 -menu .m1 wm geometry .t2 +0+0 list [update idletasks] [destroy .t2] } {{} {}} -test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {pcOnly} { +test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} win { catch {destroy .t2} catch {destroy .m1} menu .m1 @@ -1028,7 +1022,7 @@ test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {pcOnly} { list [update idletasks] [destroy .m1] [destroy .t2] } {{} {} {}} -test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest pcOnly} {} {} +test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest win} {} {} # cleanup deleteWindows diff --git a/tests/winWm.test b/tests/winWm.test index cb39e46..0140218 100644 --- a/tests/winWm.test +++ b/tests/winWm.test @@ -9,7 +9,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winWm.test,v 1.10 2003/04/01 21:07:02 dgp Exp $ +# RCS: @(#) $Id: winWm.test,v 1.11 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -32,7 +32,7 @@ update set menuheight [expr $menuheight - [winfo y .t]] destroy .t -test winWm-1.1 {TkWmMapWindow} {pcOnly} { +test winWm-1.1 {TkWmMapWindow} win { toplevel .t wm override .t 1 wm geometry .t +0+0 @@ -41,7 +41,7 @@ test winWm-1.1 {TkWmMapWindow} {pcOnly} { destroy .t set result } {0 0} -test winWm-1.2 {TkWmMapWindow} {pcOnly} { +test winWm-1.2 {TkWmMapWindow} win { toplevel .t wm transient .t . update @@ -53,7 +53,7 @@ test winWm-1.2 {TkWmMapWindow} {pcOnly} { destroy .t set msg } {can't iconify ".t": it is a transient} -test winWm-1.3 {TkWmMapWindow} {pcOnly} { +test winWm-1.3 {TkWmMapWindow} win { toplevel .t update toplevel .t2 @@ -62,7 +62,7 @@ test winWm-1.3 {TkWmMapWindow} {pcOnly} { destroy .t .t2 set result } 1 -test winWm-1.4 {TkWmMapWindow} {pcOnly} { +test winWm-1.4 {TkWmMapWindow} win { toplevel .t wm geometry .t +10+10 update @@ -73,7 +73,7 @@ test winWm-1.4 {TkWmMapWindow} {pcOnly} { destroy .t .t2 set result } {10 40} -test winWm-1.5 {TkWmMapWindow} {pcOnly} { +test winWm-1.5 {TkWmMapWindow} win { toplevel .t wm iconify .t update @@ -82,7 +82,7 @@ test winWm-1.5 {TkWmMapWindow} {pcOnly} { set result } iconic -test winWm-2.1 {TkpWmSetState} {pcOnly} { +test winWm-2.1 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update @@ -96,7 +96,7 @@ test winWm-2.1 {TkpWmSetState} {pcOnly} { destroy .t set result } {normal iconic normal} -test winWm-2.2 {TkpWmSetState} {pcOnly} { +test winWm-2.2 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update @@ -113,7 +113,7 @@ test winWm-2.2 {TkpWmSetState} {pcOnly} { destroy .t set result } {normal withdrawn iconic normal} -test winWm-2.2 {TkpWmSetState} {pcOnly} { +test winWm-2.2 {TkpWmSetState} win { toplevel .t wm geometry .t 150x50+10+10 update @@ -130,7 +130,7 @@ test winWm-2.2 {TkpWmSetState} {pcOnly} { destroy .t set result } {normal withdrawn iconic normal} -test winWm-2.4 {TkpWmSetState} {pcOnly} { +test winWm-2.4 {TkpWmSetState} win { set result {} toplevel .t wm geometry .t 150x50+10+10 @@ -149,7 +149,7 @@ test winWm-2.4 {TkpWmSetState} {pcOnly} { set result } {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}} -test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} { +test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win { toplevel .t wm geometry .t +0+0 button .t.b @@ -168,7 +168,7 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} { set x } 1 -test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} { +test winWm-4.1 {ConfigureTopLevel: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -bg red @@ -185,7 +185,7 @@ test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} { set result } [expr $menuheight + 1] -test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} { +test winWm-5.1 {UpdateGeometryInfo: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -bg red @@ -204,7 +204,7 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} { destroy .t set result } {50 50 50} -test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} { +test winWm-5.2 {UpdateGeometryInfo: menu resizing} win { set result {} toplevel .t frame .t.f -width 150 -height 50 -bg red @@ -225,17 +225,17 @@ test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} { set result } {50 50 0} -test winWm-6.1 {wm attributes} {pcOnly} { +test winWm-6.1 {wm attributes} win { destroy .t toplevel .t wm attributes .t } {-disabled 0 -toolwindow 0 -topmost 0} -test winWm-6.2 {wm attributes} {pcOnly} { +test winWm-6.2 {wm attributes} win { destroy .t toplevel .t wm attributes .t -disabled } {0} -test winWm-6.3 {wm attributes} {pcOnly} { +test winWm-6.3 {wm attributes} win { # This isn't quite the correct error message yet, but it works. destroy .t toplevel .t @@ -244,8 +244,8 @@ test winWm-6.3 {wm attributes} {pcOnly} { destroy .t -test winWm-6.1 {deiconify on an unmapped toplevel - will raise the window and set the focus} {pcOnly} { +test winWm-6.1 {deiconify on an unmapped toplevel\ + will raise the window and set the focus} win { destroy .t toplevel .t lower .t @@ -255,8 +255,8 @@ test winWm-6.1 {deiconify on an unmapped toplevel list [wm stackorder .t isabove .] [focus] } {1 .t} -test winWm-6.2 {deiconify on an already mapped toplevel - will raise the window and set the focus} {pcOnly} { +test winWm-6.2 {deiconify on an already mapped toplevel\ + will raise the window and set the focus} win { destroy .t toplevel .t lower .t diff --git a/tests/window.test b/tests/window.test index 6b7908f..6d5d9aa 100644 --- a/tests/window.test +++ b/tests/window.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: window.test,v 1.11 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: window.test,v 1.12 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -246,7 +246,7 @@ test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} \ } {0 YES} test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ - {unixOnly testmenubar} { + {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 @@ -257,7 +257,7 @@ test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ # If stacking order isn't handle properly, generates an X error. } {} test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} \ - {unixOnly testmenubar} { + {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 @@ -284,7 +284,7 @@ test window-4.2 {Tk_NameToWindow procedure} {testmenubar} { } {0 100x50+10+10} test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \ - {unixOnly testmenubar} { + {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 wm geometry .t +0+0 diff --git a/tests/winfo.test b/tests/winfo.test index 7332018..1153b52 100644 --- a/tests/winfo.test +++ b/tests/winfo.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winfo.test,v 1.12 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: winfo.test,v 1.13 2004/06/24 12:45:44 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -90,7 +90,7 @@ test winfo-3.2 {"winfo colormapfull" command} defaultPseudocolor8 { test winfo-3.3 {"winfo colormapfull" command} defaultPseudocolor8 { list [catch {winfo colormapfull foo} msg] $msg } {1 {bad window path name "foo"}} -test winfo-3.4 {"winfo colormapfull" command} {unixOnly defaultPseudocolor8} { +test winfo-3.4 {"winfo colormapfull" command} {unix defaultPseudocolor8} { eatColors .t {-colormap new} set result [list [winfo colormapfull .] [winfo colormapfull .t]] .t.c delete 34 @@ -143,10 +143,10 @@ test winfo-5.2 {"winfo interps" command} { test winfo-5.3 {"winfo interps" command} { list [catch {winfo interps -displayof geek} msg] $msg } {1 {bad window path name "geek"}} -test winfo-5.4 {"winfo interps" command} {unixOnly} { +test winfo-5.4 {"winfo interps" command} unix { expr [lsearch -exact [winfo interps] [tk appname]] >= 0 } {1} -test winfo-5.5 {"winfo interps" command} {unixOnly} { +test winfo-5.5 {"winfo interps" command} unix { expr [lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0 } {1} @@ -196,7 +196,7 @@ test winfo-7.6 {"winfo pathname" command} { test winfo-7.7 {"winfo pathname" command} { winfo pathname -displayof .b [winfo id .] } {.} -test winfo-7.8 {"winfo pathname" command} {unixOnly testwrapper} { +test winfo-7.8 {"winfo pathname" command} {unix testwrapper} { winfo pathname [testwrapper .] } {} diff --git a/tests/wm.test b/tests/wm.test index e8f2c48..2d4311b 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: wm.test,v 1.26 2004/06/16 20:03:19 jenglish Exp $ +# RCS: @(#) $Id: wm.test,v 1.27 2004/06/24 12:45:44 dkf Exp $ # This file tests window manager interactions that work across # platforms. Window manager tests that only work on a specific @@ -127,11 +127,11 @@ test wm-attributes-1.1 {usage} { list [catch {wm attributes} err] $err } {1 {wrong # args: should be "wm option window ?arg ...?"}} -test wm-attributes-1.2.1 {usage} {pcOnly} { +test wm-attributes-1.2.1 {usage} win { list [catch {wm attributes . _} err] $err } {1 {wrong # args: should be "wm attributes window ?-disabled ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}} -test wm-attributes-1.2.2 {usage} {unixOnly} { +test wm-attributes-1.2.2 {usage} unix { list [catch {wm attributes . _} err] $err } {1 {wrong # args: should be "wm attributes window"}} @@ -435,15 +435,15 @@ test wm-iconbitmap-1.1 {usage} { list [catch {wm iconbitmap} err] $err } {1 {wrong # args: should be "wm option window ?arg ...?"}} -test wm-iconbitmap-1.2.1 {usage} {unixOnly} { +test wm-iconbitmap-1.2.1 {usage} unix { list [catch {wm iconbitmap .t 12 13} msg] $msg } {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}} -test wm-iconbitmap-1.2.2 {usage} {pcOnly} { +test wm-iconbitmap-1.2.2 {usage} win { list [catch {wm iconbitmap .t 12 13 14} msg] $msg } {1 {wrong # args: should be "wm iconbitmap window ?-default? ?image?"}} -test wm-iconbitmap-1.3 {usage} {pcOnly} { +test wm-iconbitmap-1.3 {usage} win { list [catch {wm iconbitmap .t 12 13} msg] $msg } {1 {illegal option "12" must be "-default"}} diff --git a/tests/xmfbox.test b/tests/xmfbox.test index c2f3edd..7f6c3fe 100644 --- a/tests/xmfbox.test +++ b/tests/xmfbox.test @@ -10,7 +10,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. # -# RCS: @(#) $Id: xmfbox.test,v 1.9 2004/05/23 17:34:50 dkf Exp $ +# RCS: @(#) $Id: xmfbox.test,v 1.10 2004/06/24 12:45:45 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -59,14 +59,14 @@ proc cleanup {} { catch {destroy .foo} } -test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} {unixOnly} { +test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} unix { catch {unset foo} set x [tk::MotifFDialog_Create foo open {-parent .}] catch {destroy $x} set x } .foo -test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} {unixOnly} { +test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} unix { catch {unset foo} toplevel .bar wm geometry .bar +0+0 @@ -76,7 +76,7 @@ test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} {unixOnly} { set x } .bar.foo -test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} {unixOnly} { +test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} unix { cleanup file mkdir ./~nosuchuser1 set x [tk::MotifFDialog_Create foo open {}] @@ -85,7 +85,7 @@ test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} {unixOnly} { set kk [tk::MotifFDialog_InterpFilter $x] } [list $testPWD/~nosuchuser1 *] -test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} {unixOnly} { +test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} unix { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] @@ -94,7 +94,7 @@ test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} {unixOnly} { set kk [tk::MotifFDialog_InterpFilter $x] } [list $testPWD ./~nosuchuser1] -test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} {unixOnly} { +test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} unix { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] @@ -105,7 +105,7 @@ test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} {unixOnly} { $::tk::dialog::file::foo(fList) get end } ~nosuchuser1 -test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} {unixOnly} { +test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} unix { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] @@ -113,7 +113,7 @@ test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} {unixOnly} { expr {$i >= 0} } 1 -test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} {unixOnly} { +test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} unix { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] @@ -124,7 +124,7 @@ test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} {unixOnly} { $::tk::dialog::file::foo(sEnt) get } $testPWD/~nosuchuser1 -test xmfbox-2.6 {tk::MotifFDialog_ActivateFList, ~ in file names} {unixOnly} { +test xmfbox-2.6 {tk::MotifFDialog_ActivateFList, ~ in file names} unix { cleanup close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}] set x [tk::MotifFDialog_Create foo open {}] |