diff options
| -rw-r--r-- | tests/id.test | 12 | ||||
| -rw-r--r-- | tests/macFont.test | 139 | ||||
| -rw-r--r-- | tests/macMenu.test | 431 | ||||
| -rw-r--r-- | tests/macscrollbar.test | 36 | ||||
| -rw-r--r-- | tests/send.test | 790 | ||||
| -rw-r--r-- | tests/winClipboard.test | 34 | ||||
| -rw-r--r-- | tests/winDialog.test | 61 | ||||
| -rw-r--r-- | tests/winFont.test | 14 |
8 files changed, 697 insertions, 820 deletions
diff --git a/tests/id.test b/tests/id.test index 8c12a50..bfaa741 100644 --- a/tests/id.test +++ b/tests/id.test @@ -6,18 +6,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: id.test,v 1.4 1999/04/16 01:51:38 stanton Exp $ +# RCS: @(#) $Id: id.test,v 1.5 2001/09/21 20:38:18 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {[string compare testwrapper [info commands testwrapper]] != 0} { - puts "This application hasn't been compiled with the testwrapper command," - puts "therefore I am skipping all of these tests." - ::tcltest::cleanupTests - return -} +set ::tcltest::testConfig(testwrapper) \ + [llength [info commands testwrapper]] foreach i [winfo children .] { destroy $i @@ -25,7 +21,7 @@ foreach i [winfo children .] { wm geometry . {} raise . -test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly} { +test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly testwrapper} { bind all <Destroy> {lappend x %W} catch {unset map} frame .f diff --git a/tests/macFont.test b/tests/macFont.test index 7bec629..972f81d 100644 --- a/tests/macFont.test +++ b/tests/macFont.test @@ -10,18 +10,12 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macFont.test,v 1.3 1999/04/16 01:51:38 stanton Exp $ +# RCS: @(#) $Id: macFont.test,v 1.4 2001/09/21 20:38:18 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {$tcl_platform(platform)!="macintosh"} { - puts "skipping: Mac only tests..." - ::tcltest::cleanupTests - return -} - catch {destroy .b} toplevel .b update idletasks @@ -52,219 +46,219 @@ if {[font actual $gothic -family] != [font actual system -family]} { set ::tcltest::testConfig(gothic) 1 } -test macFont-1.1 {TkpFontPkgInit} { +test macFont-1.1 {TkpFontPkgInit} {macOnly} { } {} -test macfont-2.1 {TkpGetNativeFont: not native} { +test macfont-2.1 {TkpGetNativeFont: not native} {macOnly} { list [catch {font measure {} xyz} msg] $msg } {1 {font "" doesn't exist}} -test macFont-2.2 {TkpGetNativeFont: native} { +test macFont-2.2 {TkpGetNativeFont: native} {macOnly} { font measure system "0" font measure application "0" set x {} } {} -test macFont-3.1 {TkpGetFontFromAttributes: no family} { +test macFont-3.1 {TkpGetFontFromAttributes: no family} {macOnly} { font actual {-underline 1} -family } [font actual system -family] -test macFont-3.2 {TkpGetFontFromAttributes: long family name} { +test macFont-3.2 {TkpGetFontFromAttributes: long family name} {macOnly} { set x "12345678901234567890123456789012345678901234567890" set x "$x$x$x$x$x$x" font actual "-family $x" -family } [font actual system -family] -test macFont-3.3 {TkpGetFontFromAttributes: family} { +test macFont-3.3 {TkpGetFontFromAttributes: family} {macOnly} { font actual {-family Courier} -family } {Courier} -test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} { +test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} {macOnly} { set x {} lappend x [font actual {-family "Times"} -family] lappend x [font actual {-family "Times New Roman"} -family] } {Times Times} -test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} { +test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} {macOnly} { set x {} lappend x [font actual {-family "Courier"} -family] lappend x [font actual {-family "Courier New"} -family] } {Courier Courier} -test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} { +test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} {macOnly} { set x {} lappend x [font actual {-family "Geneva"} -family] lappend x [font actual {-family "Helvetica"} -family] lappend x [font actual {-family "Arial"} -family] } {Geneva Helvetica Helvetica} -test macFont-3.7 {TkpGetFontFromAttributes: try aliases} { +test macFont-3.7 {TkpGetFontFromAttributes: try aliases} {macOnly} { font actual {arial 10} -family } {Helvetica} -test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} { +test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} {macOnly} { font actual {{ms sans serif} 10} -family } {Chicago} -test macFont-3.9 {TkpGetFontFromAttributes: styles} { +test macFont-3.9 {TkpGetFontFromAttributes: styles} {macOnly} { font actual {-weight normal} -weight } {normal} -test macFont-3.10 {TkpGetFontFromAttributes: styles} { +test macFont-3.10 {TkpGetFontFromAttributes: styles} {macOnly} { font actual {-weight bold} -weight } {bold} -test macFont-3.11 {TkpGetFontFromAttributes: styles} { +test macFont-3.11 {TkpGetFontFromAttributes: styles} {macOnly} { font actual {-slant roman} -slant } {roman} -test macFont-3.12 {TkpGetFontFromAttributes: styles} { +test macFont-3.12 {TkpGetFontFromAttributes: styles} {macOnly} { font actual {-slant italic} -slant } {italic} -test macFont-3.13 {TkpGetFontFromAttributes: styles} { +test macFont-3.13 {TkpGetFontFromAttributes: styles} {macOnly} { font actual {-underline false} -underline } {0} -test macFont-3.14 {TkpGetFontFromAttributes: styles} { +test macFont-3.14 {TkpGetFontFromAttributes: styles} {macOnly} { font actual {-underline true} -underline } {1} -test macFont-3.15 {TkpGetFontFromAttributes: styles} { +test macFont-3.15 {TkpGetFontFromAttributes: styles} {macOnly} { font actual {-overstrike false} -overstrike } {0} -test macFont-3.16 {TkpGetFontFromAttributes: styles} { +test macFont-3.16 {TkpGetFontFromAttributes: styles} {macOnly} { font actual {-overstrike true} -overstrike } {0} -test macFont-4.1 {TkpDeleteFont} { +test macFont-4.1 {TkpDeleteFont} {macOnly} { font actual {-family xyz} set x {} } {} -test macFont-5.1 {TkpGetFontFamilies} { +test macFont-5.1 {TkpGetFontFamilies} {macOnly} { expr {[lsearch [font families] Geneva] > 0} } {1} -test macFont-6.1 {TkpGetSubFonts} {gothic} { +test macFont-6.1 {TkpGetSubFonts} {gothic macOnly} { .b.l config -text "abc\u4e4e" update set x [testfont subfonts $fixed] } "Monaco [font actual $gothic -family]" -test macFont-7.1 {Tk_MeasureChars: unbounded right margin} { +test macFont-7.1 {Tk_MeasureChars: unbounded right margin} {macOnly} { .b.l config -wrap 0 -text "000000" getsize } "[expr $ax*6] $ay" -test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} { +test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} {macOnly} { .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" getsize } "[expr $ax*256] $ay" -test macFont-7.3 {Tk_MeasureChars: all chars did fit} { +test macFont-7.3 {Tk_MeasureChars: all chars did fit} {macOnly} { .b.l config -wrap [expr $ax*10] -text "00000000" getsize } "[expr $ax*8] $ay" -test macFont-7.4 {Tk_MeasureChars: not all chars fit} { +test macFont-7.4 {Tk_MeasureChars: not all chars fit} {macOnly} { .b.l config -wrap [expr $ax*6] -text "00000000" getsize } "[expr $ax*6] [expr $ay*2]" -test macFont-7.5 {Tk_MeasureChars: already saw space in line} { +test macFont-7.5 {Tk_MeasureChars: already saw space in line} {macOnly} { .b.l config -wrap [expr $ax*12] -text "000000 0000000" getsize } "[expr $ax*7] [expr $ay*2]" -test macFont-7.6 {Tk_MeasureChars: internal spaces significant} { +test macFont-7.6 {Tk_MeasureChars: internal spaces significant} {macOnly} { .b.l config -wrap [expr $ax*12] -text "000 00 00000" getsize } "[expr $ax*7] [expr $ay*2]" -test macFont-7.7 {Tk_MeasureChars: include last partial char} { +test macFont-7.7 {Tk_MeasureChars: include last partial char} {macOnly} { .b.c dchars $t 0 end .b.c insert $t 0 "0000" .b.c index $t @[expr int($ax*2.5)],1 } {2} -test macFont-7.8 {Tk_MeasureChars: at least one char on line} { +test macFont-7.8 {Tk_MeasureChars: at least one char on line} { macOnly} { .b.l config -text "000000" -wrap 1 getsize } "$ax [expr $ay*6]" -test macFont-7.9 {Tk_MeasureChars: whole words} { +test macFont-7.9 {Tk_MeasureChars: whole words} {macOnly} { .b.l config -wrap [expr $ax*8] -text "000000 0000" getsize } "[expr $ax*6] [expr $ay*2]" -test macFont-7.10 {Tk_MeasureChars: make first part of word fit} { +test macFont-7.10 {Tk_MeasureChars: make first part of word fit} {macOnly} { .b.l config -wrap [expr $ax*12] -text "0000000000000000" getsize } "[expr $ax*12] [expr $ay*2]" -test macFont-7.11 {Tk_MeasureChars: numBytes == 0} { +test macFont-7.11 {Tk_MeasureChars: numBytes == 0} {macOnly} { font measure system {} } {0} -test macFont-7.12 {Tk_MeasureChars: maxLength < 0} { +test macFont-7.12 {Tk_MeasureChars: maxLength < 0} {macOnly} { font measure $courier abcd } "[expr $cx*4]" -test macFont-7.13 {Tk_MeasureChars: loop on each char} { +test macFont-7.13 {Tk_MeasureChars: loop on each char} {macOnly} { font measure $courier abcd } "[expr $cx*4]" -test macFont-7.14 {Tk_MeasureChars: p == end} { +test macFont-7.14 {Tk_MeasureChars: p == end} {macOnly} { font measure $courier abcd } "[expr $cx*4]" -test macFont-7.15 {Tk_MeasureChars: p > end} { +test macFont-7.15 {Tk_MeasureChars: p > end} {macOnly} { font measure $courier abc\xc2 } "[expr $cx*4]" -test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} { +test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} { font measure $courier abc\u4e4edef } [expr $cx*6+$mx] -test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic} { +test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} { font measure $courier \u4e4edef } [expr $mx+$cx*3] -test macFont-7.18 {Tk_MeasureChars: final measure} {gothic} { +test macFont-7.18 {Tk_MeasureChars: final measure} {gothic macOnly} { font measure $courier \u4e4edef } [expr $mx+$cx*3] -test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic} { +test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} { font measure $courier \u4e4e } [expr $mx] -test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} { +test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} {macOnly} { .b.l config -wrap [expr $ax*8] -text "000" getsize } "[expr $ax*3] $ay" -test macFont-7.21 {Tk_MeasureChars: loop on each char} { +test macFont-7.21 {Tk_MeasureChars: loop on each char} {macOnly} { .b.l config -wrap [expr $ax*8] -text "000" getsize } "[expr $ax*3] $ay" -test macFont-7.22 {Tk_MeasureChars: p == end} { +test macFont-7.22 {Tk_MeasureChars: p == end} {macOnly} { .b.l config -wrap [expr $ax*8] -text "000" getsize } "[expr $ax*3] $ay" -test macFont-7.23 {Tk_MeasureChars: p > end} { +test macFont-7.23 {Tk_MeasureChars: p > end} {macOnly} { .b.l config -wrap [expr $ax*8] -text "00\xc2" getsize } "[expr $ax*3] $ay" -test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} { +test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic macOnly} { .b.l config -wrap [expr $ax*8] -text "00\u4e4e00" getsize } "[expr $ax*4+$mx] $ay" -test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic} { +test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic macOnly} { .b.l config -wrap [expr $ax*8] -text "\u4e4e00" getsize } "[expr $mx+$ax*2] $ay" -test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic} { +test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic macOnly} { .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00" getsize } "[expr $ax*8+$mx*2] $ay" -test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic} { +test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic macOnly} { .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00" getsize } "[expr $ax*5] [expr $ay*3]" -test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic} { +test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic macOnly} { # even some of the "0"s would fit after \u4e4d, they should all wrap to next line. .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00" getsize } "[expr $ax*6+$mx] [expr $ay*3]" -test macFont-7.29 {Tk_MeasureChars: final measure} {gothic} { +test macFont-7.29 {Tk_MeasureChars: final measure} {gothic macOnly} { .b.l config -wrap [expr $ax*8] -text "\u4e4e00" getsize } "[expr $mx+$ax*2] $ay" -test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic} { +test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic macOnly} { .b.l config -wrap [expr $ax*8] -text "\u4e4e" getsize } "$mx $ay" -test macFont-7.31 {Tk_MeasureChars: rest == NULL} { +test macFont-7.31 {Tk_MeasureChars: rest == NULL} {macOnly} { .b.l config -wrap [expr $ax*1000] -text 0000 getsize } "[expr $ax*4] $ay" -test macFont-7.32 {Tk_MeasureChars: rest != NULL} { +test macFont-7.32 {Tk_MeasureChars: rest != NULL} {macOnly} { .b.l config -wrap [expr $ax*6] -text "00000000" getsize } "[expr $ax*6] [expr $ay*2]" -test macFont-8.1 {Tk_DrawChars procedure} { +test macFont-8.1 {Tk_DrawChars procedure} {macOnly} { .b.l config -text "a" update } {} -test macFont-9.1 {AllocMacFont: use old font} { +test macFont-9.1 {AllocMacFont: use old font} {macOnly} { font create xyz button .c -font xyz font configure xyz -family times @@ -272,13 +266,13 @@ test macFont-9.1 {AllocMacFont: use old font} { destroy .c font delete xyz } {} -test macFont-9.2 {AllocMacFont: extract info from style} { +test macFont-9.2 {AllocMacFont: extract info from style} {macOnly} { font actual {Monaco 9 bold italic underline overstrike} } {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0} -test macFont-9.3 {AllocMacFont: extract text metrics} { +test macFont-9.3 {AllocMacFont: extract text metrics} {macOnly} { font metric {Geneva 10} -fixed } {0} -test macFont-9.4 {AllocMacFont: extract text metrics} { +test macFont-9.4 {AllocMacFont: extract text metrics} {macOnly} { font metric "Monaco 9" -fixed } {1} @@ -287,16 +281,3 @@ destroy .b # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/macMenu.test b/tests/macMenu.test index b261180..f1ee519 100644 --- a/tests/macMenu.test +++ b/tests/macMenu.test @@ -7,25 +7,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macMenu.test,v 1.5 2001/08/01 16:21:12 dgp Exp $ +# RCS: @(#) $Id: macMenu.test,v 1.6 2001/09/21 20:38:18 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {$tcl_platform(platform) != "macintosh"} { - puts "skipping: Mac only tests..." - ::tcltest::cleanupTests - return -} - -if {[lsearch [image types] test] < 0} { - puts "This application hasn't been compiled with the \"test\" image" - puts "type, so I can't run this test. Are you sure you're using" - puts "tktest instead of wish?" - ::tcltest::cleanupTests - return -} +set ::tcltest::testConfig(testimage) \ + [expr {[lsearch [image types] test] >= 0}] proc deleteWindows {} { foreach i [winfo children .] { @@ -37,21 +26,21 @@ deleteWindows wm geometry . {} raise . -test macMenu-1.0 {TkMacUseMenuID} {} { +test macMenu-1.0 {TkMacUseMenuID} {macOnly} { # Can't really test TkMacUseMenuID; it's only called on startup. } {} -test macMenu-2.1 {GetNewID} { +test macMenu-2.1 {GetNewID} {macOnly} { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} -test macMenu-2.2 {GetNewID - cascade menu} { +test macMenu-2.2 {GetNewID - cascade menu} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m2 list [catch {menu .m2} msg] $msg [destroy .m1] [destroy .m2] } {0 .m2 {} {}} -test macMenu-2.3 {GetNewID - running out of ids} { +test macMenu-2.3 {GetNewID - running out of ids} {macOnly} { deleteWindows menu .menu for {set i 0} {$i < 230} {incr i} { @@ -62,18 +51,18 @@ test macMenu-2.3 {GetNewID - running out of ids} { list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows] } {1 {No more menus can be allocated.} {}} -test macMenu-3.1 {FreeID} { +test macMenu-3.1 {FreeID} {macOnly} { catch {destroy .m1} menu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} # No way to test running out of ids in TkpNewPlatformMenu -test macMenu-4.1 {TkpNewMenu} { +test macMenu-4.1 {TkpNewMenu} {macOnly} { catch {destroy .m1} list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2 } {0 .m1 0 {}} -test macMenu-4.2 {TkpNewMenu - checking for help menu when one is there} { +test macMenu-4.2 {TkpNewMenu - checking for help menu when one is there} {macOnly} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -84,7 +73,7 @@ test macMenu-4.2 {TkpNewMenu - checking for help menu when one is there} { update list [catch {menu .m2} msg] $msg [destroy .m1] [destroy .m2] [. configure -menu ""] } {0 .m2 {} {} {}} -test macMenu-4.3 {TkpNewMenu - menubar set but different interp} { +test macMenu-4.3 {TkpNewMenu - menubar set but different interp} {macOnly} { catch {interp delete testinterp} catch {destroy .m1} interp create testinterp @@ -95,7 +84,7 @@ test macMenu-4.3 {TkpNewMenu - menubar set but different interp} { interp eval testinterp {update} list [catch {menu .m1} msg] $msg [destroy .m1] [interp delete testinterp] } {0 .m1 {} {}} -test macMenu-4.4 {TkpNewMenu - menubar set but new menu has different parent} { +test macMenu-4.4 {TkpNewMenu - menubar set but new menu has different parent} {macOnly} { catch {destroy .m1} catch {destroy .m2} menu .m1 -tearoff 0 @@ -107,7 +96,7 @@ test macMenu-4.4 {TkpNewMenu - menubar set but new menu has different parent} { update list [catch {menu .m2.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .m2] } {0 .m2.help {} {} {}} -test macMenu-4.5 {TkpNewMenu - menubar set, same parent, not .help} { +test macMenu-4.5 {TkpNewMenu - menubar set, same parent, not .help} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.help @@ -116,7 +105,7 @@ test macMenu-4.5 {TkpNewMenu - menubar set, same parent, not .help} { update list [catch {menu .m1.foo} msg] $msg [. configure -menu ""] [destroy .m1] } {0 .m1.foo {} {}} -test macMenu-4.6 {TkpNewMenu - creating the help menu} { +test macMenu-4.6 {TkpNewMenu - creating the help menu} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.help @@ -126,12 +115,12 @@ test macMenu-4.6 {TkpNewMenu - creating the help menu} { list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] } {0 .m1.help {} {}} -test macMenu-5.1 {TkpDestroyMenu} { +test macMenu-5.1 {TkpDestroyMenu} {macOnly} { catch {destroy .m1} menu .m1 list [catch {destroy .m1} msg] $msg } {0 {}} -test macMenu-5.2 {TkpDestroyMenu - help menu} { +test macMenu-5.2 {TkpDestroyMenu - help menu} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.help @@ -141,13 +130,13 @@ test macMenu-5.2 {TkpDestroyMenu - help menu} { update list [catch {destroy .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-5.3 {TkpDestroyMenu - idle handler pending} { +test macMenu-5.3 {TkpDestroyMenu - idle handler pending} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label test list [catch {destroy .m1} msg] $msg } {0 {}} -test macMenu-5.4 {TkpDestroyMenu - idle handler not pending} { +test macMenu-5.4 {TkpDestroyMenu - idle handler not pending} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label test @@ -155,14 +144,14 @@ test macMenu-5.4 {TkpDestroyMenu - idle handler not pending} { list [catch {destroy .m1} msg] $msg } {0 {}} -test macMenu-6.1 {SetMenuCascade} { +test macMenu-6.1 {SetMenuCascade} {macOnly} { catch {destroy .m1} catch {destroy .m2} menu .m1 menu .m2 list [catch {.m2 add cascade -menu .m1} msg] $msg [destroy .m1 .m2] } {0 {} {}} -test macMenu-6.2 {SetMenuCascade - running out of ids} { +test macMenu-6.2 {SetMenuCascade - running out of ids} {macOnly} { deleteWindows menu .menu for {set i 0} {$i < 230} {incr i} { @@ -173,13 +162,13 @@ test macMenu-6.2 {SetMenuCascade - running out of ids} { list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows] } {1 {No more menus can be allocated.} {}} -test macMenu-7.1 {TkpDestroyMenuEntry} { +test macMenu-7.1 {TkpDestroyMenuEntry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [catch {.m1 delete 1} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-7.2 {TkpDestroyMenuEntry - help menu} { +test macMenu-7.2 {TkpDestroyMenuEntry - help menu} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.help @@ -191,60 +180,60 @@ test macMenu-7.2 {TkpDestroyMenuEntry - help menu} { list [catch {.m1.help delete test} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-8.1 {GetEntryText} { +test macMenu-8.1 {GetEntryText} {macOnly} { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} -test macMenu-8.2 {GetEntryText} { +test macMenu-8.2 {GetEntryText} {macOnly testimage} { 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 macMenu-8.3 {GetEntryText} { +test macMenu-8.3 {GetEntryText} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-8.4 {GetEntryText} { +test macMenu-8.4 {GetEntryText} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-8.5 {GetEntryText} { +test macMenu-8.5 {GetEntryText} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-8.6 {GetEntryText} { +test macMenu-8.6 {GetEntryText} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "This is a very long string. 9012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890"} \ msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-8.7 {GetEntryText - elipses character} { +test macMenu-8.7 {GetEntryText - elipses character} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo..."} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-8.8 {GetEntryText - false elipses character} { +test macMenu-8.8 {GetEntryText - false elipses character} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo."} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-8.9 {GetEntryText - false elipses character} { +test macMenu-8.9 {GetEntryText - false elipses character} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo.."} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-8.10 {GetEntryText - false elipses character} { +test macMenu-8.10 {GetEntryText - false elipses character} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo.b"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-8.11 {GetEntryText - false elipses character} { +test macMenu-8.11 {GetEntryText - false elipses character} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label "foo..b"} msg] $msg [destroy .m1] @@ -252,7 +241,7 @@ test macMenu-8.11 {GetEntryText - false elipses character} { # test macMenu-9.1 - assumes some fonts -test macMenu-9.1 {FindMarkCharacter} { +test macMenu-9.1 {FindMarkCharacter} {macOnly} { catch {destroy .m1} menu .m1 -font "Helvetica 12" -tearoff 0 .m1 add checkbutton -label test @@ -261,40 +250,40 @@ test macMenu-9.1 {FindMarkCharacter} { } {0 {} {}} # All standard fonts have "¥" defined. We can't test further. -test macMenu-10.1 {SetMenuIndicator - cascade entry} { +test macMenu-10.1 {SetMenuIndicator - cascade entry} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add cascade -label foo} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-10.2 {SetMenuIndicator - not radio or checkbutton} { +test macMenu-10.2 {SetMenuIndicator - not radio or checkbutton} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label foo} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-10.3 {SetMenuIndicator - indiatorOn false} { +test macMenu-10.3 {SetMenuIndicator - indiatorOn false} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add checkbutton -label foo -indicatoron 0} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-10.4 {SetMenuIndicator - entry not selected} { +test macMenu-10.4 {SetMenuIndicator - entry not selected} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add checkbutton -label foo} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-10.5 {SetMenuIndicator - checkbutton} { +test macMenu-10.5 {SetMenuIndicator - checkbutton} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo list [catch {.m1 invoke foo} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-10.6 {SetMenuIndicator - radio button} { +test macMenu-10.6 {SetMenuIndicator - radio button} {macOnly} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo list [catch {.m1 invoke foo} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-11.1 {SetMenuTitle} { +test macMenu-11.1 {SetMenuTitle} {macOnly} { catch {destroy .m1} catch {destroy .container} menu .container @@ -303,7 +292,7 @@ test macMenu-11.1 {SetMenuTitle} { .container add cascade -label "File" -menu .m1 list [catch {. configure -menu .container} msg] $msg [. configure -menu ""] [destroy .container .m1] } {0 {} {} {}} -test macMenu-11.2 {SetMenuTitle} { +test macMenu-11.2 {SetMenuTitle} {macOnly} { menu .container menu .m1 . configure -menu "" @@ -312,14 +301,14 @@ test macMenu-11.2 {SetMenuTitle} { list [catch {. configure -menu .container} msg] $msg [. configure -menu ""] [destroy .container .m1] } {0 {} {} {}} -test macMenu-12.1 {TkpConfigureMenuEntry} { +test macMenu-12.1 {TkpConfigureMenuEntry} {macOnly} { catch {destroy .m1} . configure -menu "" menu .m1 .m1 add cascade -menu .m3 list [catch {.m1 entryconfigure 1 -menu .m2} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.2 {TkpConfigureMenuEntry} { +test macMenu-12.2 {TkpConfigureMenuEntry} {macOnly} { catch {destroy .m1} catch {destroy .m2} . configure -menu "" @@ -328,7 +317,7 @@ test macMenu-12.2 {TkpConfigureMenuEntry} { menu .m2 list [catch {.m1 entryconfigure 1 -menu .m2} msg] $msg [destroy .m1 .m2] } {0 {} {}} -test macMenu-12.3 {TkpConfigureMenuEntry - running out of ids} { +test macMenu-12.3 {TkpConfigureMenuEntry - running out of ids} {macOnly} { deleteWindows menu .menu for {set i 0} {$i < 230} {incr i} { @@ -338,63 +327,63 @@ test macMenu-12.3 {TkpConfigureMenuEntry - running out of ids} { menu .breaker list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows] } {1 {No more menus can be allocated.} {}} -test macMenu-12.4 {TkpConfigureMenuEntry - Control} { +test macMenu-12.4 {TkpConfigureMenuEntry - Control} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Control+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.5 {TkpConfigureMenuEntry - Ctrl} { +test macMenu-12.5 {TkpConfigureMenuEntry - Ctrl} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Ctrl+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.6 {TkpConfigureMenuEntry - Shift} { +test macMenu-12.6 {TkpConfigureMenuEntry - Shift} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Shift+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.7 {TkpConfigureMenuEntry - Option} { +test macMenu-12.7 {TkpConfigureMenuEntry - Option} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Opt+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.8 {TkpConfigureMenuEntry - Command} { +test macMenu-12.8 {TkpConfigureMenuEntry - Command} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Command+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.9 {TkpConfigureMenuEntry - Cmd} { +test macMenu-12.9 {TkpConfigureMenuEntry - Cmd} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Cmd+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.10 {TkpConfigureMenuEntry - Alt} { +test macMenu-12.10 {TkpConfigureMenuEntry - Alt} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Alt+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.11 {TkpConfigureMenuEntry - Meta} { +test macMenu-12.11 {TkpConfigureMenuEntry - Meta} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Meta+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.12 {TkpConfigureMenuEntry - Two modifiers} { +test macMenu-12.12 {TkpConfigureMenuEntry - Two modifiers} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Cmd+Shift+S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.13 {TkpConfigureMenuEntry - dash instead of plus} { +test macMenu-12.13 {TkpConfigureMenuEntry - dash instead of plus} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -accel "Command-S"} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.14 {TkpConfigureMenuEntry - idler pending} { +test macMenu-12.14 {TkpConfigureMenuEntry - idler pending} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label test list [catch {.m1 entryconfigure test -label test2} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-12.15 {TkpConfigureMenuEntry - idler not pending} { +test macMenu-12.15 {TkpConfigureMenuEntry - idler not pending} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label test @@ -402,13 +391,13 @@ test macMenu-12.15 {TkpConfigureMenuEntry - idler not pending} { list [catch {.m1 entryconfigure test -label test2} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.1 {ReconfigureIndividualMenu - getting rid of zero items} { +test macMenu-13.1 {ReconfigureIndividualMenu - getting rid of zero items} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.2 {ReconfigureIndividualMenu - getting rid of one item} { +test macMenu-13.2 {ReconfigureIndividualMenu - getting rid of one item} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label test @@ -416,7 +405,7 @@ test macMenu-13.2 {ReconfigureIndividualMenu - getting rid of one item} { .m1 delete test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.3 {ReconfigureIndividualMenu - getting rid of more than one} { +test macMenu-13.3 {ReconfigureIndividualMenu - getting rid of more than one} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label test @@ -425,67 +414,67 @@ test macMenu-13.3 {ReconfigureIndividualMenu - getting rid of more than one} { .m1 entryconfigure test2 -label "test two" list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.4 {ReconfigureIndividualMenu - separator} { +test macMenu-13.4 {ReconfigureIndividualMenu - separator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add separator list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.5 {ReconfigureIndividualMenu - disabled} { +test macMenu-13.5 {ReconfigureIndividualMenu - disabled} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command .m1 entryconfigure 1 -state disabled list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.6 {ReconfigureIndividualMenu - active} { +test macMenu-13.6 {ReconfigureIndividualMenu - active} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command .m1 entryconfigure 1 -state active list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.7 {ReconfigureIndividualMenu - checkbutton not checked} { +test macMenu-13.7 {ReconfigureIndividualMenu - checkbutton not checked} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.8 {ReconfigureIndividualMenu - checkbutton - indicator off} { +test macMenu-13.8 {ReconfigureIndividualMenu - checkbutton - indicator off} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label test -indicatoron 0 .m1 invoke test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.9 {ReconfigureIndividualMenu - checkbutton on} { +test macMenu-13.9 {ReconfigureIndividualMenu - checkbutton on} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label test .m1 invoke test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.10 {ReconfigureIndividualMenu - radiobutton not checked} { +test macMenu-13.10 {ReconfigureIndividualMenu - radiobutton not checked} {macOnly} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.11 {ReconfigureIndividualMenu - radiobutton - indicator off} { +test macMenu-13.11 {ReconfigureIndividualMenu - radiobutton - indicator off} {macOnly} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label test -indicatoron 0 .m1 invoke test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.12 {ReconfigureIndividualMenu - radiobutton on} { +test macMenu-13.12 {ReconfigureIndividualMenu - radiobutton on} {macOnly} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label test .m1 invoke test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.13 {ReconfigureIndividualMenu} { +test macMenu-13.13 {ReconfigureIndividualMenu} {macOnly} { catch {destroy .m1} . configure -menu "" menu .m1 @@ -493,7 +482,7 @@ test macMenu-13.13 {ReconfigureIndividualMenu} { .m1 entryconfigure 1 -menu .m2 list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.14 {ReconfigureIndividualMenu} { +test macMenu-13.14 {ReconfigureIndividualMenu} {macOnly} { catch {destroy .m1} catch {destroy .m2} . configure -menu "" @@ -503,13 +492,13 @@ test macMenu-13.14 {ReconfigureIndividualMenu} { .m1 entryconfigure 1 -menu .m2 list [catch {update idletasks} msg] $msg [destroy .m1 .m2] } {0 {} {}} -test macMenu-13.15 {ReconfigureIndividualMenu - accelerator} { +test macMenu-13.15 {ReconfigureIndividualMenu - accelerator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -accel "Command-S" list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.16 {ReconfigureIndividualMenu - parent is disabled} { +test macMenu-13.16 {ReconfigureIndividualMenu - parent is disabled} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label .m1.edit -label "Edit" -state disabled @@ -517,7 +506,7 @@ test macMenu-13.16 {ReconfigureIndividualMenu - parent is disabled} { .m1.edit add command -label foo list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-13.17 {ReconfigureIndividualMenu - disabling parent} { +test macMenu-13.17 {ReconfigureIndividualMenu - disabling parent} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label .m1.edit -label Edit @@ -527,13 +516,13 @@ test macMenu-13.17 {ReconfigureIndividualMenu - disabling parent} { list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-14.1 {ReconfigureMacintoshMenu - normal menu} { +test macMenu-14.1 {ReconfigureMacintoshMenu - normal menu} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label test list [catch {update idletasks} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-14.2 {ReconfigureMacintoshMenu - apple menu} { +test macMenu-14.2 {ReconfigureMacintoshMenu - apple menu} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.apple @@ -543,7 +532,7 @@ test macMenu-14.2 {ReconfigureMacintoshMenu - apple menu} { raise . list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-14.3 {ReconfigureMacintoshMenu - help menu} { +test macMenu-14.3 {ReconfigureMacintoshMenu - help menu} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.help @@ -553,7 +542,7 @@ test macMenu-14.3 {ReconfigureMacintoshMenu - help menu} { raise . list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-14.4 {ReconfigureMacintoshMenu - menubar} { +test macMenu-14.4 {ReconfigureMacintoshMenu - menubar} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.file -label "foo" @@ -564,20 +553,20 @@ test macMenu-14.4 {ReconfigureMacintoshMenu - menubar} { list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-15.1 {CompleteIdlers - no idle pending} { +test macMenu-15.1 {CompleteIdlers - no idle pending} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label test update idletasks list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-15.2 {CompleteIdlers - idle pending} { +test macMenu-15.2 {CompleteIdlers - idle pending} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label test list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-15.3 {CompleteIdlers - recursive} { +test macMenu-15.3 {CompleteIdlers - recursive} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.m2 -label test @@ -587,38 +576,38 @@ test macMenu-15.3 {CompleteIdlers - recursive} { } {0 {} {}} #Don't know how to generate nested post menus -test macMenu-16.1 {TkpPostMenu} { +test macMenu-16.1 {TkpPostMenu} {macOnly} { catch {destroy .m1} menu .m1 -postcommand "destroy .m1" list [catch {.m1 post 40 40} msg] $msg } {0 {}} -test macMenu-16.2 {TkpPostMenu} { +test macMenu-16.2 {TkpPostMenu} {macOnly} { catch {destroy .m1} menu .m1 -postcommand "blork" list [catch {.m1 post 40 40} msg] $msg [destroy .m1] } {1 {invalid command name "blork"} {}} # We need to write the interactive test for menu posting. -test macMenu-17.1 {TkpMenuNewEntry - no idle pending} { +test macMenu-17.1 {TkpMenuNewEntry - no idle pending} {macOnly} { catch {destroy .m1} menu .m1 list [catch {.m1 add command -label test} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-17.2 {TkpMenuNewEntry - idle pending} { +test macMenu-17.2 {TkpMenuNewEntry - idle pending} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label test list [catch {.m1 add command -label test2} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-18.1 {DrawMenuBarWhenIdle} { +test macMenu-18.1 {DrawMenuBarWhenIdle} {macOnly} { catch {destroy .m1} . configure -menu "" menu .m1 . configure -menu .m1 list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.2 {DrawMenuBarWhenIdle - clearing old apple menu out} { +test macMenu-18.2 {DrawMenuBarWhenIdle - clearing old apple menu out} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.apple @@ -631,7 +620,7 @@ test macMenu-18.2 {DrawMenuBarWhenIdle - clearing old apple menu out} { raise . list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-18.3 {DrawMenuBarWhenIdle - clearing out old help menu} { +test macMenu-18.3 {DrawMenuBarWhenIdle - clearing out old help menu} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.help @@ -644,27 +633,27 @@ test macMenu-18.3 {DrawMenuBarWhenIdle - clearing out old help menu} { raise . list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-18.4 {DrawMenuBarWhenIdle - menu not there} { +test macMenu-18.4 {DrawMenuBarWhenIdle - menu not there} {macOnly} { catch {destroy .m1} . configure -menu .m1 raise . list [catch {update} msg] $msg [. configure -menu ""] } {0 {} {}} -test macMenu-18.5 {DrawMenuBarWhenIdle - menu there} { +test macMenu-18.5 {DrawMenuBarWhenIdle - menu there} {macOnly} { catch {destroy .m1} menu .m1 . configure -menu .m1 raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.6 {DrawMenuBarWhenIdle - no apple menu} { +test macMenu-18.6 {DrawMenuBarWhenIdle - no apple menu} {macOnly} { catch {destroy .m1} menu .m1 . configure -menu .m1 raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.7 {DrawMenuBarWhenIdle - apple menu references but not there} { +test macMenu-18.7 {DrawMenuBarWhenIdle - apple menu references but not there} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.apple @@ -672,7 +661,7 @@ test macMenu-18.7 {DrawMenuBarWhenIdle - apple menu references but not there} { raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.8 {DrawMenuBarWhenIdle - apple menu there} { +test macMenu-18.8 {DrawMenuBarWhenIdle - apple menu there} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.apple @@ -682,7 +671,7 @@ test macMenu-18.8 {DrawMenuBarWhenIdle - apple menu there} { raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.9 {DrawMenuBarWhenIdle - apple menu there; no idle handler} { +test macMenu-18.9 {DrawMenuBarWhenIdle - apple menu there; no idle handler} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.apple @@ -693,14 +682,14 @@ test macMenu-18.9 {DrawMenuBarWhenIdle - apple menu there; no idle handler} { update idletasks list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.10 {DrawMenuBarWhenIdle - no help menu} { +test macMenu-18.10 {DrawMenuBarWhenIdle - no help menu} {macOnly} { catch {destroy .m1} menu .m1 . configure -menu .m1 raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.11 {DrawMenuBarWhenIdle - help menu referenced but not there} { +test macMenu-18.11 {DrawMenuBarWhenIdle - help menu referenced but not there} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.help @@ -708,7 +697,7 @@ test macMenu-18.11 {DrawMenuBarWhenIdle - help menu referenced but not there} { raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.12 {DrawMenuBarWhenIdle - help menu there} { +test macMenu-18.12 {DrawMenuBarWhenIdle - help menu there} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.help @@ -718,7 +707,7 @@ test macMenu-18.12 {DrawMenuBarWhenIdle - help menu there} { raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.13 {DrawMenuBarWhenIdle - help menu there - no idlers} { +test macMenu-18.13 {DrawMenuBarWhenIdle - help menu there - no idlers} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.help @@ -730,7 +719,7 @@ test macMenu-18.13 {DrawMenuBarWhenIdle - help menu there - no idlers} { list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} # Can't generate no menubar clone -test macMenu-18.14 {DrawMenuBarWhenIdle - apple and help menus in tearoff menubar} { +test macMenu-18.14 {DrawMenuBarWhenIdle - apple and help menus in tearoff menubar} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -menu .m1.apple @@ -741,7 +730,7 @@ test macMenu-18.14 {DrawMenuBarWhenIdle - apple and help menus in tearoff menuba raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.15 {DrawMenuBarWhenIdle - apple and help menus in non-tearoff menubar} { +test macMenu-18.15 {DrawMenuBarWhenIdle - apple and help menus in non-tearoff menubar} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add cascade -menu .m1.apple @@ -752,14 +741,14 @@ test macMenu-18.15 {DrawMenuBarWhenIdle - apple and help menus in non-tearoff me raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.16 {DrawMenuBarWhenIdle - no apple menu} { +test macMenu-18.16 {DrawMenuBarWhenIdle - no apple menu} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 . configure -menu .m1 raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.17 {DrawMenuBarWhenIdle - apple menu} { +test macMenu-18.17 {DrawMenuBarWhenIdle - apple menu} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 . configure -menu .m1 @@ -770,7 +759,7 @@ test macMenu-18.17 {DrawMenuBarWhenIdle - apple menu} { raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.18 {DrawMenuBarWhenIdle - big for loop} { +test macMenu-18.18 {DrawMenuBarWhenIdle - big for loop} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 menu .m1.apple -tearoff 0 @@ -783,7 +772,7 @@ test macMenu-18.18 {DrawMenuBarWhenIdle - big for loop} { raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-18.19 {DrawMenuBarWhenIdle = disabled menu} { +test macMenu-18.19 {DrawMenuBarWhenIdle = disabled menu} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 menu .m1.edit -tearoff 0 @@ -794,7 +783,7 @@ test macMenu-18.19 {DrawMenuBarWhenIdle = disabled menu} { list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-19.1 {RecursivelyInsertMenu} { +test macMenu-19.1 {RecursivelyInsertMenu} {macOnly} { catch {destroy .m1} catch {destroy .m2} catch {destroy .main} @@ -810,7 +799,7 @@ test macMenu-19.1 {RecursivelyInsertMenu} { .m2 add command -label "Test 3" list [catch {raise .t2} msg] $msg [destroy .t2 .main .m1 .m2] } {0 {} {}} -test macMenu-19.2 {RecursivelyInsertMenu} { +test macMenu-19.2 {RecursivelyInsertMenu} {macOnly} { catch {destroy .m1} catch {destroy .m2} catch {destroy .main} @@ -827,13 +816,13 @@ test macMenu-19.2 {RecursivelyInsertMenu} { list [catch {raise .t2} msg] $msg [destroy .t2 .main .m1 .m2] } {0 {} {}} -test macMenu-20.1 {SetDefaultMenuBar} { +test macMenu-20.1 {SetDefaultMenuBar} {macOnly} { . configure -menu "" raise . list [catch {update} msg] $msg } {0 {}} -test macMenu-21.1 {TkpSetMainMenubar - not front window} { +test macMenu-21.1 {TkpSetMainMenubar - not front window} {macOnly} { catch {destroy .m1} catch {destroy .t2} toplevel .t2 @@ -843,12 +832,12 @@ test macMenu-21.1 {TkpSetMainMenubar - not front window} { update list [catch {.t2 configure -menu .m1} msg] $msg [destroy .t2] [destroy .m1] } {0 {} {} {}} -test macMenu-21.2 {TkpSetMainMenubar - menu null} { +test macMenu-21.2 {TkpSetMainMenubar - menu null} {macOnly} { . configure -menu "" raise . list [catch {update} msg] $msg } {0 {}} -test macMenu-21.3 {TkpSetMainMenubar - different interps} { +test macMenu-21.3 {TkpSetMainMenubar - different interps} {macOnly} { catch {destroy .m1} catch {interp delete testinterp} interp create testinterp @@ -862,7 +851,7 @@ test macMenu-21.3 {TkpSetMainMenubar - different interps} { interp eval testinterp {raise .} list [catch {interp eval testinterp {update}} msg] $msg [interp delete testinterp] [. configure -menu ""] [destroy .m1] } {0 {} {} {} {}} -test macMenu-21.4 {TkpSetMainMenubar - different windows} { +test macMenu-21.4 {TkpSetMainMenubar - different windows} {macOnly} { catch {destroy .m1} catch {destroy .t2} menu .m1 @@ -875,7 +864,7 @@ test macMenu-21.4 {TkpSetMainMenubar - different windows} { raise .t2 list [catch {update} msg] $msg [destroy .t2] [. configure -menu ""] [destroy .m1] } {0 {} {} {} {}} -test macMenu-21.5 {TkpSetMainMenubar - old menu was null} { +test macMenu-21.5 {TkpSetMainMenubar - old menu was null} {macOnly} { catch {destroy .m1} . configure -menu "" update @@ -884,7 +873,7 @@ test macMenu-21.5 {TkpSetMainMenubar - old menu was null} { raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] } {0 {} {} {}} -test macMenu-21.6 {TkpSetMainMenubar - old menu different} { +test macMenu-21.6 {TkpSetMainMenubar - old menu different} {macOnly} { catch {destroy .m1} catch {destroy .m2} menu .m1 @@ -896,7 +885,7 @@ test macMenu-21.6 {TkpSetMainMenubar - old menu different} { raise . list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .m2] } {0 {} {} {} {}} -test macMenu-21.7 {TkpSetMainMenubar - child window NULL - parent window now} { +test macMenu-21.7 {TkpSetMainMenubar - child window NULL - parent window now} {macOnly} { catch {destroy .m1} catch {destroy .t2} toplevel .t2 @@ -908,7 +897,7 @@ test macMenu-21.7 {TkpSetMainMenubar - child window NULL - parent window now} { raise .t2 list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .t2] } {0 {} {} {} {}} -test macMenu-21.8 {TkpSetMainMenubar - tearoff window} { +test macMenu-21.8 {TkpSetMainMenubar - tearoff window} {macOnly} { catch {destroy .t2} toplevel .t2 -menu .t2.m1 menu .t2.m1 @@ -920,14 +909,14 @@ test macMenu-21.8 {TkpSetMainMenubar - tearoff window} { list [catch {update} msg] $msg [destroy .t2] } {0 {} {}} -test macMenu-22.1 {TkSetWindowMenuBar} { +test macMenu-22.1 {TkSetWindowMenuBar} {macOnly} { } {} -test macMenu-23.1 {TkMacDispatchMenuEvent} { +test macMenu-23.1 {TkMacDispatchMenuEvent} {macOnly} { # needs to be interactive. } {} -test macMenu-24.1 {GetMenuIndicatorGeometry} { +test macMenu-24.1 {GetMenuIndicatorGeometry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -935,80 +924,80 @@ test macMenu-24.1 {GetMenuIndicatorGeometry} { list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.1 {GetMenuAccelGeometry - cascade entry} { +test macMenu-25.1 {GetMenuAccelGeometry - cascade entry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.2 {GetMenuAccelGeometry - no accel} { +test macMenu-25.2 {GetMenuAccelGeometry - no accel} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.3 {GetMenuAccelGeometry - no special chars - arbitrary string} { +test macMenu-25.3 {GetMenuAccelGeometry - no special chars - arbitrary string} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -accel "Test" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.4 {GetMenuAccelGeometry - Command} { +test macMenu-25.4 {GetMenuAccelGeometry - Command} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+S" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.5 {GetMenuAccelGeometry - Control} { +test macMenu-25.5 {GetMenuAccelGeometry - Control} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+S" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.6 {GetMenuAccelGeometry - Shift} { +test macMenu-25.6 {GetMenuAccelGeometry - Shift} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Shift+S" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.7 {GetMenuAccelGeometry - Option} { +test macMenu-25.7 {GetMenuAccelGeometry - Option} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Opt+S" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.8 {GetMenuAccelGeometry - Combination} { +test macMenu-25.8 {GetMenuAccelGeometry - Combination} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+Shift+S" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-25.9 {GetMenuAccelGeometry - extra text} { +test macMenu-25.9 {GetMenuAccelGeometry - extra text} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Command+Delete" list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-26.1 {GetTearoffEntryGeometry} { +test macMenu-26.1 {GetTearoffEntryGeometry} {macOnly} { # can't call this on power mac. } {} -test macMenu-27.1 {GetMenuSeparatorGeometry} { +test macMenu-27.1 {GetMenuSeparatorGeometry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add separator list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1] } {0 {}} -test macMenu-28.1 {DrawMenuEntryIndicator - non-checkbutton} { +test macMenu-28.1 {DrawMenuEntryIndicator - non-checkbutton} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-28.2 {DrawMenuEntryIndicator - indicator off} { +test macMenu-28.2 {DrawMenuEntryIndicator - indicator off} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -indicatoron 0 @@ -1016,14 +1005,14 @@ test macMenu-28.2 {DrawMenuEntryIndicator - indicator off} { set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-28.3 {DrawMenuEntryIndicator - not selected} { +test macMenu-28.3 {DrawMenuEntryIndicator - not selected} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-28.4 {DrawMenuEntryIndicator - checkbutton} { +test macMenu-28.4 {DrawMenuEntryIndicator - checkbutton} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -1031,7 +1020,7 @@ test macMenu-28.4 {DrawMenuEntryIndicator - checkbutton} { set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-28.5 {DrawMenuEntryIndicator - radiobutton} { +test macMenu-28.5 {DrawMenuEntryIndicator - radiobutton} {macOnly} { catch {destroy .m1} menu .m1 .m1 add radiobutton -label foo @@ -1041,7 +1030,7 @@ test macMenu-28.5 {DrawMenuEntryIndicator - radiobutton} { } {0 {} {}} # Cannot reproduce resources missing or color allocation failing easily. -test macMenu-29.1 {DrawSICN} { +test macMenu-29.1 {DrawSICN} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+S" @@ -1050,56 +1039,56 @@ test macMenu-29.1 {DrawSICN} { } {0 {} {}} # Cannot reproduce resources missing -test macMenu-30.1 {DrawMenuEntryAccelerator - cascade entry} { +test macMenu-30.1 {DrawMenuEntryAccelerator - cascade entry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-30.2 {DrawMenuEntryAccelerator - no accel string} { +test macMenu-30.2 {DrawMenuEntryAccelerator - no accel string} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-30.3 {DrawMenuEntryAccelerator - random accel string} { +test macMenu-30.3 {DrawMenuEntryAccelerator - random accel string} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel foo set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-30.4 {DrawMenuEntryAccelerator - Command} { +test macMenu-30.4 {DrawMenuEntryAccelerator - Command} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+S" set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-30.5 {DrawMenuEntryAccelerator - Option} { +test macMenu-30.5 {DrawMenuEntryAccelerator - Option} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Opt+S" set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-30.6 {DrawMenuEntryAccelerator - Shift} { +test macMenu-30.6 {DrawMenuEntryAccelerator - Shift} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Shift+S" set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-30.7 {DrawMenuEntryAccelerator - Control} { +test macMenu-30.7 {DrawMenuEntryAccelerator - Control} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Ctrl+S" set tearoff [tk::TearOffMenu .m1 40 40] list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-30.8 {DrawMenuEntryAccelerator - combination} { +test macMenu-30.8 {DrawMenuEntryAccelerator - combination} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -accel "Cmd+Shift+S" @@ -1107,7 +1096,7 @@ test macMenu-30.8 {DrawMenuEntryAccelerator - combination} { list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-31.1 {DrawMenuSeparator} { +test macMenu-31.1 {DrawMenuSeparator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add separator @@ -1115,7 +1104,7 @@ test macMenu-31.1 {DrawMenuSeparator} { list [catch {update} msg] $msg [destroy .m1] } {0 {} {}} -test macMenu-32.1 {TkpDrawMenuEntryLabel} { +test macMenu-32.1 {TkpDrawMenuEntryLabel} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -1127,7 +1116,7 @@ test macMenu-33.1 {MenuDefProc - No way to test automatically.} {} {} test macMenu-34.1 {TkMacHandleTearoffMenu - no way to test automatically} {} {} test macMenu-35.1 {TkpInitializeMenuBindings - nothing to do} {} {} -test macMenu-36.1 {TkpComputeMenubarGeometry} { +test macMenu-36.1 {TkpComputeMenubarGeometry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label foo @@ -1139,7 +1128,7 @@ test macMenu-37.1 {DrawTearoffEntry - can't do automatically} {} {} test macMenu-38.1 {TkMacSetHelpMenuItemCount - called at boot time} {} {} test macMenu-39.1 {TkMacMenuClick - can't do automatically} {} {} -test macMenu-40.1 {TkpDrawMenuEntry - gc for active and not strict motif} { +test macMenu-40.1 {TkpDrawMenuEntry - gc for active and not strict motif} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -1147,7 +1136,7 @@ test macMenu-40.1 {TkpDrawMenuEntry - gc for active and not strict motif} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test macMenu-40.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} { +test macMenu-40.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground red @@ -1155,7 +1144,7 @@ test macMenu-40.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test macMenu-40.3 {TkpDrawMenuEntry - gc for active and strict motif} { +test macMenu-40.3 {TkpDrawMenuEntry - gc for active and strict motif} {macOnly} { catch {destroy .m1} menu .m1 set tk_strictMotif 1 @@ -1164,42 +1153,42 @@ test macMenu-40.3 {TkpDrawMenuEntry - gc for active and strict motif} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} -test macMenu-40.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} { +test macMenu-40.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} {macOnly} { 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 macMenu-40.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} { +test macMenu-40.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {macOnly} { 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 macMenu-40.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} { +test macMenu-40.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {macOnly} { 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 macMenu-40.7 {TkpDrawMenuEntry - gc for normal - custom entry} { +test macMenu-40.7 {TkpDrawMenuEntry - gc for normal - custom entry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -foreground red set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-40.8 {TkpDrawMenuEntry - gc for normal} { +test macMenu-40.8 {TkpDrawMenuEntry - gc for normal} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-40.9 {TkpDrawMenuEntry - gc for indicator - custom entry} { +test macMenu-40.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo -selectcolor orange @@ -1207,7 +1196,7 @@ test macMenu-40.9 {TkpDrawMenuEntry - gc for indicator - custom entry} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-40.10 {TkpDrawMenuEntry - gc for indicator} { +test macMenu-40.10 {TkpDrawMenuEntry - gc for indicator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label foo @@ -1215,7 +1204,7 @@ test macMenu-40.10 {TkpDrawMenuEntry - gc for indicator} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-40.11 {TkpDrawMenuEntry - border - custom entry} { +test macMenu-40.11 {TkpDrawMenuEntry - border - custom entry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activebackground green @@ -1223,7 +1212,7 @@ test macMenu-40.11 {TkpDrawMenuEntry - border - custom entry} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test macMenu-40.12 {TkpDrawMenuEntry - border} { +test macMenu-40.12 {TkpDrawMenuEntry - border} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -1231,7 +1220,7 @@ test macMenu-40.12 {TkpDrawMenuEntry - border} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test macMenu-40.13 {TkpDrawMenuEntry - active border - strict motif} { +test macMenu-40.13 {TkpDrawMenuEntry - active border - strict motif} {macOnly} { catch {destroy .m1} set tk_strictMotif 1 menu .m1 @@ -1240,7 +1229,7 @@ test macMenu-40.13 {TkpDrawMenuEntry - active border - strict motif} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] [set tk_strictMotif 0] } {{} {} 0} -test macMenu-40.14 {TkpDrawMenuEntry - active border - custom entry} { +test macMenu-40.14 {TkpDrawMenuEntry - active border - custom entry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo -activeforeground yellow @@ -1248,7 +1237,7 @@ test macMenu-40.14 {TkpDrawMenuEntry - active border - custom entry} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test macMenu-40.15 {TkpDrawMenuEntry - active border} { +test macMenu-40.15 {TkpDrawMenuEntry - active border} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -1256,35 +1245,35 @@ test macMenu-40.15 {TkpDrawMenuEntry - active border} { .m1 entryconfigure 1 -state active list [update] [destroy .m1] } {{} {}} -test macMenu-40.16 {TkpDrawMenuEntry - font - custom entry} { +test macMenu-40.16 {TkpDrawMenuEntry - font - custom entry} {macOnly} { 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 macMenu-40.17 {TkpDrawMenuEntry - font} { +test macMenu-40.17 {TkpDrawMenuEntry - font} {macOnly} { 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 macMenu-40.18 {TkpDrawMenuEntry - separator} { +test macMenu-40.18 {TkpDrawMenuEntry - separator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add separator set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-40.19 {TkpDrawMenuEntry - standard} { +test macMenu-40.19 {TkpDrawMenuEntry - standard} {macOnly} { catch {destroy .mb} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-40.20 {TkpDrawMenuEntry - disabled cascade item} { +test macMenu-40.20 {TkpDrawMenuEntry - disabled cascade item} {macOnly} { catch {destroy .m1} menu .m1 .m1 add cascade -label File -menu .m1.file @@ -1294,7 +1283,7 @@ test macMenu-40.20 {TkpDrawMenuEntry - disabled cascade item} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-40.21 {TkpDrawMenuEntry - indicator} { +test macMenu-40.21 {TkpDrawMenuEntry - indicator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label macMenu-40.20 @@ -1302,7 +1291,7 @@ test macMenu-40.21 {TkpDrawMenuEntry - indicator} { set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-40.22 {TkpDrawMenuEntry - indicator - hideMargin} { +test macMenu-40.22 {TkpDrawMenuEntry - indicator - hideMargin} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label macMenu-40.21 -hidemargin 1 @@ -1311,84 +1300,84 @@ test macMenu-40.22 {TkpDrawMenuEntry - indicator - hideMargin} { list [update] [destroy .m1] } {{} {}} -test macMenu-41.1 {TkpComputeStandardMenuGeometry - no entries} { +test macMenu-41.1 {TkpComputeStandardMenuGeometry - no entries} {macOnly} { catch {destroy .m1} menu .m1 list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.2 {TkpComputeStandardMenuGeometry - one entry} { +test macMenu-41.2 {TkpComputeStandardMenuGeometry - one entry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "one" list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.3 {TkpComputeStandardMenuGeometry - more than one entry} { +test macMenu-41.3 {TkpComputeStandardMenuGeometry - more than one entry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "one" .m1 add command -label "two" list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.4 {TkpComputeStandardMenuGeometry - separator} { +test macMenu-41.4 {TkpComputeStandardMenuGeometry - separator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add separator list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.5 {TkpComputeStandardMenuGeometry - standard label geometry} { +test macMenu-41.5 {TkpComputeStandardMenuGeometry - standard label geometry} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "test" list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.6 {TkpComputeStandardMenuGeometry - different font for entry} { +test macMenu-41.6 {TkpComputeStandardMenuGeometry - different font for entry} {macOnly} { catch {destroy .m1} menu .m1 -font "Helvetica 12" .m1 add command -label "test" -font "Courier 12" list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.7 {TkpComputeStandardMenuGeometry - second entry larger} { +test macMenu-41.7 {TkpComputeStandardMenuGeometry - second entry larger} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "test" .m1 add command -label "test test" list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.8 {TkpComputeStandardMenuGeometry - first entry larger} { +test macMenu-41.8 {TkpComputeStandardMenuGeometry - first entry larger} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "test test" .m1 add command -label "test" list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.9 {TkpComputeStandardMenuGeometry - accelerator} { +test macMenu-41.9 {TkpComputeStandardMenuGeometry - accelerator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "test" -accel "Ctrl+S" list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.10 {TkpComputeStandardMenuGeometry - second accel larger} { +test macMenu-41.10 {TkpComputeStandardMenuGeometry - second accel larger} {macOnly} { 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 macMenu-41.11 {TkpComputeStandardMenuGeometry - second accel smaller} { +test macMenu-41.11 {TkpComputeStandardMenuGeometry - second accel smaller} {macOnly} { 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 macMenu-41.12 {TkpComputeStandardMenuGeometry - indicator} { +test macMenu-41.12 {TkpComputeStandardMenuGeometry - indicator} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label test .m1 invoke 1 list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.13 {TkpComputeStandardMenuGeometry - second indicator less or equal } { +test macMenu-41.13 {TkpComputeStandardMenuGeometry - second indicator less or equal } {macOnly testimage} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -1399,19 +1388,19 @@ test macMenu-41.13 {TkpComputeStandardMenuGeometry - second indicator less or eq .m1 invoke 2 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test macMenu-41.14 {TkpComputeStandardMenuGeometry - hidden margin} { +test macMenu-41.14 {TkpComputeStandardMenuGeometry - hidden margin} {macOnly} { catch {destroy .m1} menu .m1 .m1 add checkbutton -label macMenu-41.15 -hidemargin 1 .m1 invoke macMenu-41.15 list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.15 {TkpComputeStandardMenuGeometry - zero sized menus} { +test macMenu-41.15 {TkpComputeStandardMenuGeometry - zero sized menus} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.16 {TkpComputeStandardMenuGeometry - first column bigger} { +test macMenu-41.16 {TkpComputeStandardMenuGeometry - first column bigger} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label one @@ -1419,7 +1408,7 @@ test macMenu-41.16 {TkpComputeStandardMenuGeometry - first column bigger} { .m1 add command -label three -columnbreak 1 list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.17 {TkpComputeStandardMenuGeometry - second column bigger} { +test macMenu-41.17 {TkpComputeStandardMenuGeometry - second column bigger} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one @@ -1427,7 +1416,7 @@ test macMenu-41.17 {TkpComputeStandardMenuGeometry - second column bigger} { .m1 add command -label three list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.18 {TkpComputeStandardMenuGeometry - three columns} { +test macMenu-41.18 {TkpComputeStandardMenuGeometry - three columns} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label one @@ -1438,14 +1427,14 @@ test macMenu-41.18 {TkpComputeStandardMenuGeometry - three columns} { .m1 add command -label six list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.19 {TkpComputeStandardMenuGeometry - entry without accel long} { +test macMenu-41.19 {TkpComputeStandardMenuGeometry - entry without accel long} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label "This is a long item with no accel." .m1 add command -label foo -accel "Cmd+S" list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.20 {TkpComputeStandardMenuGeometry - entry with accel long} { +test macMenu-41.20 {TkpComputeStandardMenuGeometry - entry with accel long} {macOnly} { catch {destroy .m1} menu .m1 -tearoff 0 .m1 add command -label foo @@ -1453,14 +1442,14 @@ test macMenu-41.20 {TkpComputeStandardMenuGeometry - entry with accel long} { list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-42.1 {DrawMenuEntryLabel - setting indicatorSpace} { +test macMenu-42.1 {DrawMenuEntryLabel - setting indicatorSpace} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "foo" set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-42.2 {DrawMenuEntryLabel - drawing image} { +test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testimage} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -1469,7 +1458,7 @@ test macMenu-42.2 {DrawMenuEntryLabel - drawing image} { set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} { +test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} {macOnly testimage} { catch {destroy .m1} catch {eval image delete [image names]} image create test image1 @@ -1480,35 +1469,35 @@ test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} { set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] [eval image delete [image names]] } {{} {} {}} -test macMenu-42.4 {DrawMenuEntryLabel - drawing a bitmap} { +test macMenu-42.4 {DrawMenuEntryLabel - drawing a bitmap} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -bitmap questhead set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-42.5 {DrawMenuEntryLabel - drawing null label} { +test macMenu-42.5 {DrawMenuEntryLabel - drawing null label} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-42.6 {DrawMenuEntryLabel - drawing real label} { +test macMenu-42.6 {DrawMenuEntryLabel - drawing real label} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a long label" -underline 3 set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-42.7 {DrawMenuEntryLabel - drawing disabled label} { +test macMenu-42.7 {DrawMenuEntryLabel - drawing disabled label} {macOnly} { catch {destroy .m1} menu .m1 -disabledforeground "" .m1 add command -label "This is a long label" -state disabled set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-42.8 {DrawMenuEntryLabel - disabled images} { +test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testimage} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -1518,7 +1507,7 @@ test macMenu-42.8 {DrawMenuEntryLabel - disabled images} { list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test macMenu-43.1 {GetMenuLabelGeometry - image} { +test macMenu-43.1 {GetMenuLabelGeometry - image} {macOnly testimage} { catch {destroy .m1} catch {image delete image1} menu .m1 @@ -1526,33 +1515,33 @@ test macMenu-43.1 {GetMenuLabelGeometry - image} { .m1 add command -image image1 list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test macMenu-43.2 {GetMenuLabelGeometry - bitmap} { +test macMenu-43.2 {GetMenuLabelGeometry - bitmap} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -bitmap questhead list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-43.3 {GetMenuLabelGeometry - no text} { +test macMenu-43.3 {GetMenuLabelGeometry - no text} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-43.4 {GetMenuLabelGeometry - text} { +test macMenu-43.4 {GetMenuLabelGeometry - text} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label "This is a test." list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-44.1 {DrawMenuEntryBackground} { +test macMenu-44.1 {DrawMenuEntryBackground} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo set tearoff [tk::TearOffMenu .m1 40 40] list [update] [destroy .m1] } {{} {}} -test macMenu-44.2 {DrawMenuEntryBackground} { +test macMenu-44.2 {DrawMenuEntryBackground} {macOnly} { catch {destroy .m1} menu .m1 .m1 add command -label foo @@ -1561,22 +1550,10 @@ test macMenu-44.2 {DrawMenuEntryBackground} { list [update] [destroy .m1] } {{} {}} -test macMenu-45.1 {TkpMenuInit - called at boot time} {} {} +test macMenu-45.1 {TkpMenuInit - called at boot time} {macOnly} { +} {} # cleanup deleteWindows ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/macscrollbar.test b/tests/macscrollbar.test index 4abf137..479f8c6 100644 --- a/tests/macscrollbar.test +++ b/tests/macscrollbar.test @@ -7,19 +7,12 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macscrollbar.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ +# RCS: @(#) $Id: macscrollbar.test,v 1.4 2001/09/21 20:38:18 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } -# Only run this test on the Macintosh -if {$tcl_platform(platform) != "macintosh"} { - puts "skipping: Mac only tests..." - ::tcltest::cleanupTests - return -} - foreach i [winfo children .] { destroy $i } @@ -32,10 +25,10 @@ wm geometry . 50x300 scrollbar .s pack .s -fill y -expand 1 update -test macscroll-1.1 {TkpDisplayScrollbar procedure} { +test macscroll-1.1 {TkpDisplayScrollbar procedure} {macOnly} { list [.s configure -width] [.s configure -bd] } {{-width width Width 16 16} {-borderwidth borderWidth BorderWidth 0 0}} -test macscroll-1.2 {TkpDisplayScrollbar procedure} { +test macscroll-1.2 {TkpDisplayScrollbar procedure} {macOnly} { # Exercise drawing 3D relief pack .s -fill y -expand 1 -anchor center .s configure -bd 4 @@ -43,7 +36,7 @@ test macscroll-1.2 {TkpDisplayScrollbar procedure} { focus .s update } {} -test macscroll-1.3 {TkpDisplayScrollbar procedure} { +test macscroll-1.3 {TkpDisplayScrollbar procedure} {macOnly} { pack .s -fill y -expand 1 -anchor e update set x [.s configure -width] @@ -51,7 +44,7 @@ test macscroll-1.3 {TkpDisplayScrollbar procedure} { update list [.s configure -width] $x } {{-width width Width 16 16} {-width width Width 16 16}} -test macscroll-1.4 {TkpDisplayScrollbar procedure} { +test macscroll-1.4 {TkpDisplayScrollbar procedure} {macOnly} { wm geometry . 300x50 .s configure -bd 0 -orient horizontal pack .s -fill x -expand 1 -anchor center @@ -64,7 +57,7 @@ test macscroll-1.4 {TkpDisplayScrollbar procedure} { update list [.s configure -width] $x $y } {{-width width Width 16 16} {-width width Width 16 16} {-width width Width 16 16}} -test macscroll-1.5 {TkpDisplayScrollbar procedure} { +test macscroll-1.5 {TkpDisplayScrollbar procedure} {macOnly} { wm geometry . 300x16 .s configure -bd 0 -orient horizontal pack .s -fill x -expand 1 -anchor s @@ -74,7 +67,7 @@ test macscroll-1.5 {TkpDisplayScrollbar procedure} { wm geometry . 300x14 update } {} -test macscroll-1.6 {TkpDisplayScrollbar procedure} { +test macscroll-1.6 {TkpDisplayScrollbar procedure} {macOnly} { # Check the drawing of the resize hack wm geometry . 20x300 wm resizable . 1 1 @@ -90,7 +83,7 @@ test macscroll-1.6 {TkpDisplayScrollbar procedure} { update list $x $y [.s identify 12 295] } {{} arrow2 arrow2} -test macscroll-1.7 {TkpDisplayScrollbar procedure} { +test macscroll-1.7 {TkpDisplayScrollbar procedure} {macOnly} { wm geometry . 300x300 pack .s -fill y -expand 1 -anchor e catch {destroy .s2} @@ -105,16 +98,3 @@ foreach i [winfo children .] { # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/send.test b/tests/send.test index c2263c2..9efd4bd 100644 --- a/tests/send.test +++ b/tests/send.test @@ -5,9 +5,12 @@ # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. +# Copyright (c) 2001 by ActiveState Corporation. # -# RCS: @(#) $Id: send.test,v 1.4 2001/08/30 01:51:42 hobbs Exp $ +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: send.test,v 1.5 2001/09/21 20:38:18 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -15,30 +18,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # 'send' is only available on Unix... -if {$tcl_platform(platform) == "macintosh"} { - puts "send is not available on the Mac - skipping tests" - ::tcltest::cleanupTests - return -} -if {$tcl_platform(platform) == "window"} { - puts "send is not available under Windows - skipping tests" - ::tcltest::cleanupTests - return -} -if {[auto_execok xhost] == ""} { - puts "xhost application isn't available - skipping tests" - ::tcltest::cleanupTests - return -} - +set ::tcltest::testConfig(xhost) [string compare {} [auto_execok xhost]] +set ::tcltest::testConfig(testsend) [llength [info commands testsend]] set ::tcltest::testConfig(altDisplay) [info exists env(TK_ALT_DISPLAY)] -if {[info commands testsend] == "testsend"} { - set gotTestCmds 1 -} else { - set gotTestCmds 0 -} - foreach i [winfo children .] { destroy $i } @@ -51,9 +34,9 @@ raise . setupbg set app [dobg {tk appname}] if {[catch {send $app set a 0} msg] == 1} { - if [string match "X server insecure *" $msg] { - puts -nonewline "Your X server is insecure, so \"send\" can't be used;" - puts " skipping \"send\" tests." + if {[string match "X server insecure *" $msg]} { + puts "Your X server is insecure - \"send\" can't be used;\ + skipping \"send\" tests." cleanupbg ::tcltest::cleanupTests return @@ -80,7 +63,7 @@ proc newApp {screen name class} { } set name [tk appname] -if $gotTestCmds { +catch { set registry [testsend prop root InterpRegistry] set commId [lindex [testsend prop root InterpRegistry] 0] } @@ -88,161 +71,160 @@ tk appname tktest catch {send t_s_1 destroy .} catch {send t_s_2 destroy .} -if $gotTestCmds { - test send-1.1 {RegOpen procedure, bogus property} { - testsend bogus - set result [winfo interps] - tk appname tktest - list $result [winfo interps] - } {{} tktest} - test send-1.2 {RegOpen procedure, bogus property} { - testsend prop root InterpRegistry {} - set result [winfo interps] - tk appname tktest - list $result [winfo interps] - } {{} tktest} - test send-1.3 {RegOpen procedure, bogus property} { - testsend prop root InterpRegistry abcdefg - tk appname tktest - set x [testsend prop root InterpRegistry] - string range $x [string first " " $x] end - } " tktest\nabcdefg\n" - - frame .f -width 1 -height 1 - set id [string range [winfo id .f] 2 end] - test send-2.1 {RegFindName procedure} { - testsend prop root InterpRegistry {} - list [catch {send foo bar} msg] $msg - } {1 {no application named "foo"}} - test send-2.2 {RegFindName procedure} { - testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n" - tk appname foo - } {foo #2} - test send-2.3 {RegFindName procedure} { - testsend prop root InterpRegistry "gyz foo\n" - tk appname foo - } {foo} - test send-2.4 {RegFindName procedure} { - testsend prop root InterpRegistry "${id}z foo\n" - tk appname foo - } {foo} - - test send-3.1 {RegDeleteName procedure} { - tk appname tktest - testsend prop root InterpRegistry "012345 gorp\n12345 foo\n12345 tktest" - tk appname x - set x [testsend prop root InterpRegistry] - string range $x [string first " " $x] end - } " x\n012345 gorp\n12345 foo\n" - test send-3.2 {RegDeleteName procedure} { - tk appname tktest - testsend prop root InterpRegistry "012345 gorp\n12345 tktest\n23456 tktest" - tk appname x - set x [testsend prop root InterpRegistry] - string range $x [string first " " $x] end - } " x\n012345 gorp\n23456 tktest\n" - test send-3.3 {RegDeleteName procedure} { - tk appname tktest - testsend prop root InterpRegistry "012345 tktest\n12345 bar\n23456 tktest" - tk appname x - set x [testsend prop root InterpRegistry] - string range $x [string first " " $x] end - } " x\n12345 bar\n23456 tktest\n" - test send-3.4 {RegDeleteName procedure} { - tk appname tktest - testsend prop root InterpRegistry "foo" - tk appname x - set x [testsend prop root InterpRegistry] - string range $x [string first " " $x] end - } " x\nfoo\n" - test send-3.5 {RegDeleteName procedure} { - tk appname tktest - testsend prop root InterpRegistry "" - tk appname x - set x [testsend prop root InterpRegistry] - string range $x [string first " " $x] end - } " x\n" - - test send-4.1 {RegAddName procedure} { - testsend prop root InterpRegistry "" - tk appname bar - testsend prop root InterpRegistry - } "$commId bar\n" - test send-4.2 {RegAddName procedure} { - testsend prop root InterpRegistry "abc def" - tk appname bar - tk appname foo - testsend prop root InterpRegistry - } "$commId foo\nabc def\n" - - # Previous checks should already cover the Regclose procedure. - - test send-5.1 {ValidateName procedure} { - testsend prop root InterpRegistry "123 abc\n" - winfo interps - } {} - test send-5.2 {ValidateName procedure} { - testsend prop root InterpRegistry "$id Hi there" - winfo interps - } {{Hi there}} - test send-5.3 {ValidateName procedure} { - testsend prop root InterpRegistry "$id Bogus" - list [catch {send Bogus set a 44} msg] $msg - } {1 {target application died or uses a Tk version before 4.0}} - test send-5.4 {ValidateName procedure} { - tk appname test - testsend prop root InterpRegistry "$commId Bogus\n$commId test\n" - winfo interps - } {test} -} +test send-1.1 {RegOpen procedure, bogus property} {unixOnly testsend} { + testsend bogus + set result [winfo interps] + tk appname tktest + list $result [winfo interps] +} {{} tktest} +test send-1.2 {RegOpen procedure, bogus property} {unixOnly testsend} { + testsend prop root InterpRegistry {} + set result [winfo interps] + tk appname tktest + list $result [winfo interps] +} {{} tktest} +test send-1.3 {RegOpen procedure, bogus property} {unixOnly testsend} { + testsend prop root InterpRegistry abcdefg + tk appname tktest + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end +} " tktest\nabcdefg\n" -winfo interps -tk appname tktest -update -setupbg -set x [split [exec xhost] \n] -foreach i [lrange $x 1 end] { - exec xhost - $i +frame .f -width 1 -height 1 +set id [string range [winfo id .f] 2 end] +test send-2.1 {RegFindName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry {} + list [catch {send foo bar} msg] $msg +} {1 {no application named "foo"}} +test send-2.2 {RegFindName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n" + tk appname foo +} {foo #2} +test send-2.3 {RegFindName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "gyz foo\n" + tk appname foo +} {foo} +test send-2.4 {RegFindName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "${id}z foo\n" + tk appname foo +} {foo} + +test send-3.1 {RegDeleteName procedure} {unixOnly testsend} { + tk appname tktest + testsend prop root InterpRegistry "012345 gorp\n12345 foo\n12345 tktest" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end +} " x\n012345 gorp\n12345 foo\n" +test send-3.2 {RegDeleteName procedure} {unixOnly testsend} { + tk appname tktest + testsend prop root InterpRegistry "012345 gorp\n12345 tktest\n23456 tktest" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end +} " x\n012345 gorp\n23456 tktest\n" +test send-3.3 {RegDeleteName procedure} {unixOnly testsend} { + tk appname tktest + testsend prop root InterpRegistry "012345 tktest\n12345 bar\n23456 tktest" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end +} " x\n12345 bar\n23456 tktest\n" +test send-3.4 {RegDeleteName procedure} {unixOnly testsend} { + tk appname tktest + testsend prop root InterpRegistry "foo" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end +} " x\nfoo\n" +test send-3.5 {RegDeleteName procedure} {unixOnly testsend} { + tk appname tktest + testsend prop root InterpRegistry "" + tk appname x + set x [testsend prop root InterpRegistry] + string range $x [string first " " $x] end +} " x\n" + +test send-4.1 {RegAddName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "" + tk appname bar + testsend prop root InterpRegistry +} "$commId bar\n" +test send-4.2 {RegAddName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "abc def" + tk appname bar + tk appname foo + testsend prop root InterpRegistry +} "$commId foo\nabc def\n" + +# Previous checks should already cover the Regclose procedure. + +test send-5.1 {ValidateName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "123 abc\n" + winfo interps +} {} +test send-5.2 {ValidateName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "$id Hi there" + winfo interps +} {{Hi there}} +test send-5.3 {ValidateName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "$id Bogus" + list [catch {send Bogus set a 44} msg] $msg +} {1 {target application died or uses a Tk version before 4.0}} +test send-5.4 {ValidateName procedure} {unixOnly testsend} { + tk appname test + testsend prop root InterpRegistry "$commId Bogus\n$commId test\n" + winfo interps +} {test} + +if {$::tcltest::testConfig(xhost)} { + winfo interps + tk appname tktest + update + setupbg + set x [split [exec xhost] \n] + foreach i [lrange $x 1 end] { + exec xhost - $i + } } -test send-6.1 {ServerSecure procedure} {nonPortable} { + +test send-6.1 {ServerSecure procedure} {nonPortable unixOnly} { set a 44 list [dobg [list send [tk appname] set a 55]] $a } {55 55} -test send-6.2 {ServerSecure procedure} {nonPortable} { +test send-6.2 {ServerSecure procedure} {nonPortable unixOnly} { set a 22 exec xhost [exec hostname] list [catch {dobg [list send [tk appname] set a 33]} msg] $a $msg } {0 22 {X server insecure (must use xauth-style authorization); command ignored}} -test send-6.3 {ServerSecure procedure} {nonPortable} { +test send-6.3 {ServerSecure procedure} {nonPortable unixOnly} { set a abc exec xhost - [exec hostname] list [dobg [list send [tk appname] set a new]] $a } {new new} cleanupbg -if $gotTestCmds { - test send-7.1 {Tk_SetAppName procedure} { - testsend prop root InterpRegistry "" - tk appname newName - list [tk appname oldName] [testsend prop root InterpRegistry] - } "oldName {$commId oldName\n}" - test send-7.2 {Tk_SetAppName procedure, name not in use} { - testsend prop root InterpRegistry "" - list [tk appname gorp] [testsend prop root InterpRegistry] - } "gorp {$commId gorp\n}" - test send-7.3 {Tk_SetAppName procedure, name in use by us} { - tk appname name1 - testsend prop root InterpRegistry "$commId name2\n" - list [tk appname name2] [testsend prop root InterpRegistry] - } "name2 {$commId name2\n}" - test send-7.4 {Tk_SetAppName procedure, name in use} { - tk appname name1 - testsend prop root InterpRegistry "$id foo\n$id foo #2\n$id foo #3\n" - list [tk appname foo] [testsend prop root InterpRegistry] - } "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}" -} - -test send-8.1 {Tk_SendCmd procedure, options} { +test send-7.1 {Tk_SetAppName procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "" + tk appname newName + list [tk appname oldName] [testsend prop root InterpRegistry] +} "oldName {$commId oldName\n}" +test send-7.2 {Tk_SetAppName procedure, name not in use} {unixOnly testsend} { + testsend prop root InterpRegistry "" + list [tk appname gorp] [testsend prop root InterpRegistry] +} "gorp {$commId gorp\n}" +test send-7.3 {Tk_SetAppName procedure, name in use by us} {unixOnly testsend} { + tk appname name1 + testsend prop root InterpRegistry "$commId name2\n" + list [tk appname name2] [testsend prop root InterpRegistry] +} "name2 {$commId name2\n}" +test send-7.4 {Tk_SetAppName procedure, name in use} {unixOnly testsend} { + tk appname name1 + testsend prop root InterpRegistry "$id foo\n$id foo #2\n$id foo #3\n" + list [tk appname foo] [testsend prop root InterpRegistry] +} "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}" + +test send-8.1 {Tk_SendCmd procedure, options} {unixOnly} { setupbg set app [dobg {tk appname}] set a 66 @@ -253,7 +235,7 @@ test send-8.1 {Tk_SendCmd procedure, options} { cleanupbg lappend result $a } {66 77} -test send-8.2 {Tk_SendCmd procedure, options} {altDisplay} { +test send-8.2 {Tk_SendCmd procedure, options} {unixOnly altDisplay} { setupbg -display $env(TK_ALT_DISPLAY) tk appname xyzgorp set a homeDisplay @@ -267,29 +249,29 @@ test send-8.2 {Tk_SendCmd procedure, options} {altDisplay} { cleanupbg set result } {altDisplay homeDisplay} -test send-8.3 {Tk_SendCmd procedure, options} { +test send-8.3 {Tk_SendCmd procedure, options} {unixOnly} { list [catch {send -- -async foo bar baz} msg] $msg } {1 {no application named "-async"}} -test send-8.4 {Tk_SendCmd procedure, options} { +test send-8.4 {Tk_SendCmd procedure, options} {unixOnly} { list [catch {send -gorp foo bar baz} msg] $msg } {1 {bad option "-gorp": must be -async, -displayof, or --}} -test send-8.5 {Tk_SendCmd procedure, options} { +test send-8.5 {Tk_SendCmd procedure, options} {unixOnly} { list [catch {send -async foo} msg] $msg } {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} -test send-8.6 {Tk_SendCmd procedure, options} { +test send-8.6 {Tk_SendCmd procedure, options} {unixOnly} { list [catch {send foo} msg] $msg } {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}} -test send-8.7 {Tk_SendCmd procedure, local execution} { +test send-8.7 {Tk_SendCmd procedure, local execution} {unixOnly} { set a initial send [tk appname] {set a new} set a } {new} -test send-8.8 {Tk_SendCmd procedure, local execution} { +test send-8.8 {Tk_SendCmd procedure, local execution} {unixOnly} { set a initial send [tk appname] set a new set a } {new} -test send-8.9 {Tk_SendCmd procedure, local execution} { +test send-8.9 {Tk_SendCmd procedure, local execution} {unixOnly} { set a initial string tolower [list [catch {send [tk appname] open bad_file} msg] \ $msg $errorInfo $errorCode] @@ -298,52 +280,58 @@ test send-8.9 {Tk_SendCmd procedure, local execution} { "open bad_file" invoked from within "send [tk appname] open bad_file"} {posix enoent {no such file or directory}}} -test send-8.10 {Tk_SendCmd procedure, no such interpreter} { +test send-8.10 {Tk_SendCmd procedure, no such interpreter} {unixOnly} { list [catch {send bogus_name bogus_command} msg] $msg } {1 {no application named "bogus_name"}} -if $gotTestCmds { + +catch { newApp "" t_s_1 Test t_s_1 eval wm withdraw . - test send-8.11 {Tk_SendCmd procedure, local execution, different interp} { - set a us - send t_s_1 set a them - list $a [send t_s_1 set a] - } {us them} - test send-8.12 {Tk_SendCmd procedure, local execution, different interp} { - set a us - send t_s_1 {set a them} - list $a [send t_s_1 {set a}] - } {us them} - test send-8.13 {Tk_SendCmd procedure, local execution, different interp} { - set a us - send t_s_1 {set a them} - list $a [send t_s_1 {set a}] - } {us them} - test send-8.14 {Tk_SendCmd procedure, local interp killed by send} { - newApp "" t_s_2 Test - list [catch {send t_s_2 {destroy .; concat result}} msg] $msg - } {0 result} - interp delete t_s_2 - test send-8.15 {Tk_SendCmd procedure, local interp, error info} { - catch {error foo} - list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode - } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory +} + +test send-8.11 {Tk_SendCmd procedure, local execution, different interp} {unixOnly testsend} { + set a us + send t_s_1 set a them + list $a [send t_s_1 set a] +} {us them} +test send-8.12 {Tk_SendCmd procedure, local execution, different interp} {unixOnly testsend} { + set a us + send t_s_1 {set a them} + list $a [send t_s_1 {set a}] +} {us them} +test send-8.13 {Tk_SendCmd procedure, local execution, different interp} {unixOnly testsend} { + set a us + send t_s_1 {set a them} + list $a [send t_s_1 {set a}] +} {us them} +test send-8.14 {Tk_SendCmd procedure, local interp killed by send} {unixOnly testsend} { + newApp "" t_s_2 Test + list [catch {send t_s_2 {destroy .; concat result}} msg] $msg +} {0 result} + +catch {interp delete t_s_2} + +test send-8.15 {Tk_SendCmd procedure, local interp, error info} {unixOnly testsend} { + catch {error foo} + list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode +} {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory while executing "open bogus_file_name" invoked from within "if 1 {open bogus_file_name}" invoked from within "send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}} - test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} { - testsend prop root InterpRegistry "10234 bogus\n" - set result [list [catch {send bogus bogus command} msg] $msg] - winfo interps - tk appname tktest - set result - } {1 {no application named "bogus"}} - interp delete t_s_1 -} -test send-8.17 {Tk_SendCmd procedure, deferring events} {nonPortable} { +test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {unixOnly testsend} { + testsend prop root InterpRegistry "10234 bogus\n" + set result [list [catch {send bogus bogus command} msg] $msg] + winfo interps + tk appname tktest + set result +} {1 {no application named "bogus"}} + +catch {interp delete t_s_1} + +test send-8.17 {Tk_SendCmd procedure, deferring events} {unixOnly nonPortable} { # Non-portable because some window managers ignore "raise" # requests so can't guarantee that new app's window won't # obscure .f, thereby masking the Expose event. @@ -363,7 +351,7 @@ test send-8.17 {Tk_SendCmd procedure, deferring events} {nonPortable} { cleanupbg lappend result $a } {{no event yet} {no event yet} exposed} -test send-8.18 {Tk_SendCmd procedure, error in remote app} { +test send-8.18 {Tk_SendCmd procedure, error in remote app} {unixOnly} { setupbg set app [dobg {tk appname}] set result [string tolower [list [catch {send $app open bad_name} msg] \ @@ -375,7 +363,7 @@ test send-8.18 {Tk_SendCmd procedure, error in remote app} { "open bad_name" invoked from within "send $app open bad_name"} {posix enoent {no such file or directory}}} -test send-8.19 {Tk_SendCmd, using modal timeouts} { +test send-8.19 {Tk_SendCmd, using modal timeouts} {unixOnly} { setupbg set app [dobg {tk appname}] set x no @@ -392,74 +380,75 @@ tk appname tktest catch {destroy .f} frame .f set id [string range [winfo id .f] 2 end] -if $gotTestCmds { - test send-9.1 {Tk_GetInterpNames procedure} { - testsend prop root InterpRegistry \ - "$commId tktest\nfoo bar\n$commId tktest\n$id frame .f\n\n\n" - list [winfo interps] [testsend prop root InterpRegistry] - } "{tktest tktest {frame .f}} {$commId tktest\n$commId tktest\n$id frame .f + +test send-9.1 {Tk_GetInterpNames procedure} {unixOnly testsend} { + testsend prop root InterpRegistry \ + "$commId tktest\nfoo bar\n$commId tktest\n$id frame .f\n\n\n" + list [winfo interps] [testsend prop root InterpRegistry] +} "{tktest tktest {frame .f}} {$commId tktest\n$commId tktest\n$id frame .f }" - test send-9.2 {Tk_GetInterpNames procedure} { - testsend prop root InterpRegistry \ - "$commId tktest\nfoobar\n$commId gorp\n" - list [winfo interps] [testsend prop root InterpRegistry] - } "tktest {$commId tktest\n}" - test send-9.3 {Tk_GetInterpNames procedure} { - testsend prop root InterpRegistry {} - list [winfo interps] [testsend prop root InterpRegistry] - } {{} {}} - - testsend prop root InterpRegistry "$commId tktest\n$id dummy\n" - test send-10.1 {SendEventProc procedure, bogus comm property} { - testsend prop comm Comm {abc def} - testsend prop comm Comm {} - update - } {} - test send-10.2 {SendEventProc procedure, simultaneous messages} { - testsend prop comm Comm \ - "c\n-n tktest\n-s set a 44\nc\n-n tktest\n-s set b 45\n" - set a null - set b xyzzy - update - list $a $b - } {44 45} - test send-10.3 {SendEventProc procedure, simultaneous messages} { - testsend prop comm Comm \ - "c\n-n tktest\n-s set a newA\nr\n-s [testsend serial]\n-r 12345\nc\n-n tktest\n-s set b newB\n" - set a null - set b xyzzy - set x [send dummy bogus] - list $x $a $b - } {12345 newA newB} - test send-10.4 {SendEventProc procedure, leading nulls, bogus commands} { - testsend prop comm Comm \ - "\n\nx\n-bogus\n\nc\n-n tktest\n-s set a 44\n" - set a null - update - set a - } {44} - test send-10.5 {SendEventProc procedure, extraneous command options} { - testsend prop comm Comm \ - "c\n-n tktest\n-x miscellanous\n-y who knows?\n-s set a new\n" - set a null - update - set a - } {new} - test send-10.6 {SendEventProc procedure, unknown interpreter} { - testsend prop [winfo id .f] Comm {} - testsend prop comm Comm \ - "c\n-n unknown\n-r $id 44\n-s set a new\n" - set a null - update - list [testsend prop [winfo id .f] Comm] $a - } "{\nr\n-s 44\n-r receiver never heard of interpreter \"unknown\"\n-c 1\n} null" - test send-10.7 {SendEventProc procedure, error in script} { - testsend prop [winfo id .f] Comm {} - testsend prop comm Comm \ - "c\n-n tktest\n-r $id 62\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n" - update - testsend prop [winfo id .f] Comm - } { +test send-9.2 {Tk_GetInterpNames procedure} {unixOnly testsend} { + testsend prop root InterpRegistry \ + "$commId tktest\nfoobar\n$commId gorp\n" + list [winfo interps] [testsend prop root InterpRegistry] +} "tktest {$commId tktest\n}" +test send-9.3 {Tk_GetInterpNames procedure} {unixOnly testsend} { + testsend prop root InterpRegistry {} + list [winfo interps] [testsend prop root InterpRegistry] +} {{} {}} + +catch {testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"} + +test send-10.1 {SendEventProc procedure, bogus comm property} {unixOnly testsend} { + testsend prop comm Comm {abc def} + testsend prop comm Comm {} + update +} {} +test send-10.2 {SendEventProc procedure, simultaneous messages} {unixOnly testsend} { + testsend prop comm Comm \ + "c\n-n tktest\n-s set a 44\nc\n-n tktest\n-s set b 45\n" + set a null + set b xyzzy + update + list $a $b +} {44 45} +test send-10.3 {SendEventProc procedure, simultaneous messages} {unixOnly testsend} { + testsend prop comm Comm \ + "c\n-n tktest\n-s set a newA\nr\n-s [testsend serial]\n-r 12345\nc\n-n tktest\n-s set b newB\n" + set a null + set b xyzzy + set x [send dummy bogus] + list $x $a $b +} {12345 newA newB} +test send-10.4 {SendEventProc procedure, leading nulls, bogus commands} {unixOnly testsend} { + testsend prop comm Comm \ + "\n\nx\n-bogus\n\nc\n-n tktest\n-s set a 44\n" + set a null + update + set a +} {44} +test send-10.5 {SendEventProc procedure, extraneous command options} {unixOnly testsend} { + testsend prop comm Comm \ + "c\n-n tktest\n-x miscellanous\n-y who knows?\n-s set a new\n" + set a null + update + set a +} {new} +test send-10.6 {SendEventProc procedure, unknown interpreter} {unixOnly testsend} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n unknown\n-r $id 44\n-s set a new\n" + set a null + update + list [testsend prop [winfo id .f] Comm] $a +} "{\nr\n-s 44\n-r receiver never heard of interpreter \"unknown\"\n-c 1\n} null" +test send-10.7 {SendEventProc procedure, error in script} {unixOnly testsend} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-r $id 62\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n" + update + testsend prop [winfo id .f] Comm +} { r -s 62 -r test error @@ -470,117 +459,117 @@ r -e test code -c 1 } - test send-10.8 {SendEventProc procedure, exceptional return} { - testsend prop [winfo id .f] Comm {} - testsend prop comm Comm \ - "c\n-n tktest\n-r $id 62\n-s break\n" - update - testsend prop [winfo id .f] Comm - } { +test send-10.8 {SendEventProc procedure, exceptional return} {unixOnly testsend} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-r $id 62\n-s break\n" + update + testsend prop [winfo id .f] Comm +} { r -s 62 -r -c 3 } - test send-10.9 {SendEventProc procedure, empty return} { - testsend prop [winfo id .f] Comm {} - testsend prop comm Comm \ - "c\n-n tktest\n-r $id 62\n-s concat\n" - update - testsend prop [winfo id .f] Comm - } { +test send-10.9 {SendEventProc procedure, empty return} {unixOnly testsend} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-r $id 62\n-s concat\n" + update + testsend prop [winfo id .f] Comm +} { r -s 62 -r } - test send-10.10 {SendEventProc procedure, asynchronous calls} { - testsend prop [winfo id .f] Comm {} - testsend prop comm Comm \ - "c\n-n tktest\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n" - update - testsend prop [winfo id .f] Comm - } {} - test send-10.11 {SendEventProc procedure, exceptional return} { - testsend prop [winfo id .f] Comm {} - testsend prop comm Comm \ - "c\n-n tktest\n-s break\n" - update - testsend prop [winfo id .f] Comm - } {} - test send-10.12 {SendEventProc procedure, empty return} { - testsend prop [winfo id .f] Comm {} - testsend prop comm Comm \ - "c\n-n tktest\n-s concat\n" - update - testsend prop [winfo id .f] Comm - } {} - test send-10.13 {SendEventProc procedure, return processing} { - testsend prop comm Comm \ - "r\n-c 1\n-e test1\n-i test2\n-r test3\n-s [testsend serial]\n" - list [catch {send dummy foo} msg] $msg $errorInfo $errorCode - } {1 test3 {test2 +test send-10.10 {SendEventProc procedure, asynchronous calls} {unixOnly testsend} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n" + update + testsend prop [winfo id .f] Comm +} {} +test send-10.11 {SendEventProc procedure, exceptional return} {unixOnly testsend} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-s break\n" + update + testsend prop [winfo id .f] Comm +} {} +test send-10.12 {SendEventProc procedure, empty return} {unixOnly testsend} { + testsend prop [winfo id .f] Comm {} + testsend prop comm Comm \ + "c\n-n tktest\n-s concat\n" + update + testsend prop [winfo id .f] Comm +} {} +test send-10.13 {SendEventProc procedure, return processing} {unixOnly testsend} { + testsend prop comm Comm \ + "r\n-c 1\n-e test1\n-i test2\n-r test3\n-s [testsend serial]\n" + list [catch {send dummy foo} msg] $msg $errorInfo $errorCode +} {1 test3 {test2 invoked from within "send dummy foo"} test1} - test send-10.14 {SendEventProc procedure, extraneous return options} { - testsend prop comm Comm \ - "r\n-x test1\n-y test2\n-r result\n-s [testsend serial]\n" - list [catch {send dummy foo} msg] $msg - } {0 result} - test send-10.15 {SendEventProc procedure, serial number} { - testsend prop comm Comm \ - "r\n-r response\n" - list [catch {send dummy foo} msg] $msg - } {1 {target application died or uses a Tk version before 4.0}} - test send-10.16 {SendEventProc procedure, serial number} { - testsend prop comm Comm \ - "r\n-r response\n\n-s 0" - list [catch {send dummy foo} msg] $msg - } {1 {target application died or uses a Tk version before 4.0}} - test send-10.17 {SendEventProc procedure, errorCode and errorInfo} { - testsend prop comm Comm \ - "r\n-i test1\n-e test2\n-c 4\n-s [testsend serial]\n" - set errorCode oldErrorCode - set errorInfo oldErrorInfo - list [catch {send dummy foo} msg] $msg $errorInfo $errorCode - } {4 {} oldErrorInfo oldErrorCode} - test send-10.18 {SendEventProc procedure, send kills application} { - setupbg - dobg {tk appname t_s_3} - set x [list [catch {send t_s_3 destroy .} msg] $msg] - cleanupbg - set x - } {0 {}} - test send-10.19 {SendEventProc procedure, send exits} { - setupbg - dobg {tk appname t_s_3} - set x [list [catch {send t_s_3 exit} msg] $msg] - close $::tcltest::fd - set x - } {1 {target application died}} - - test send-11.1 {AppendPropCarefully and AppendErrorProc procedures} { - testsend prop root InterpRegistry "0x21447 dummy\n" - list [catch {send dummy foo} msg] $msg - } {1 {no application named "dummy"}} - test send-11.2 {AppendPropCarefully and AppendErrorProc procedures} { - testsend prop comm Comm "c\n-r0x123 44\n-n tktest\n-s concat a b c\n" - update - } {} -} +test send-10.14 {SendEventProc procedure, extraneous return options} {unixOnly testsend} { + testsend prop comm Comm \ + "r\n-x test1\n-y test2\n-r result\n-s [testsend serial]\n" + list [catch {send dummy foo} msg] $msg +} {0 result} +test send-10.15 {SendEventProc procedure, serial number} {unixOnly testsend} { + testsend prop comm Comm \ + "r\n-r response\n" + list [catch {send dummy foo} msg] $msg +} {1 {target application died or uses a Tk version before 4.0}} +test send-10.16 {SendEventProc procedure, serial number} {unixOnly testsend} { + testsend prop comm Comm \ + "r\n-r response\n\n-s 0" + list [catch {send dummy foo} msg] $msg +} {1 {target application died or uses a Tk version before 4.0}} +test send-10.17 {SendEventProc procedure, errorCode and errorInfo} {unixOnly testsend} { + testsend prop comm Comm \ + "r\n-i test1\n-e test2\n-c 4\n-s [testsend serial]\n" + set errorCode oldErrorCode + set errorInfo oldErrorInfo + list [catch {send dummy foo} msg] $msg $errorInfo $errorCode +} {4 {} oldErrorInfo oldErrorCode} +test send-10.18 {SendEventProc procedure, send kills application} {unixOnly testsend} { + setupbg + dobg {tk appname t_s_3} + set x [list [catch {send t_s_3 destroy .} msg] $msg] + cleanupbg + set x +} {0 {}} +test send-10.19 {SendEventProc procedure, send exits} {unixOnly testsend} { + setupbg + dobg {tk appname t_s_3} + set x [list [catch {send t_s_3 exit} msg] $msg] + close $::tcltest::fd + set x +} {1 {target application died}} + +test send-11.1 {AppendPropCarefully and AppendErrorProc procedures} {unixOnly testsend} { + testsend prop root InterpRegistry "0x21447 dummy\n" + list [catch {send dummy foo} msg] $msg +} {1 {no application named "dummy"}} +test send-11.2 {AppendPropCarefully and AppendErrorProc procedures} {unixOnly testsend} { + testsend prop comm Comm "c\n-r0x123 44\n-n tktest\n-s concat a b c\n" + update +} {} winfo interps tk appname tktest catch {destroy .f} frame .f set id [string range [winfo id .f] 2 end] -if $gotTestCmds { - test send-12.1 {TimeoutProc procedure} { - testsend prop root InterpRegistry "$id dummy\n" - list [catch {send dummy foo} msg] $msg - } {1 {target application died or uses a Tk version before 4.0}} - testsend prop root InterpRegistry "" -} -test send-12.2 {TimeoutProc procedure} { + +test send-12.1 {TimeoutProc procedure} {unixOnly testsend} { + testsend prop root InterpRegistry "$id dummy\n" + list [catch {send dummy foo} msg] $msg +} {1 {target application died or uses a Tk version before 4.0}} + +catch {testsend prop root InterpRegistry ""} + +test send-12.2 {TimeoutProc procedure} {unixOnly} { winfo interps tk appname tktest update @@ -599,14 +588,14 @@ test send-12.2 {TimeoutProc procedure} { winfo interps tk appname tktest -test send-13.1 {DeleteProc procedure} { +test send-13.1 {DeleteProc procedure} {unixOnly} { setupbg set app [dobg {rename send {}; tk appname}] set result [list [catch {send $app foo} msg] $msg [winfo interps]] cleanupbg set result } {1 {no application named "tktest #2"} tktest} -test send-13.2 {DeleteProc procedure} { +test send-13.2 {DeleteProc procedure} {unixOnly} { winfo interps tk appname tktest rename send {} @@ -616,7 +605,7 @@ test send-13.2 {DeleteProc procedure} { lappend result [winfo interps] [info commands send] } {{} {} foo send} -test send-14.1 {SendRestrictProc procedure, sends crossing from different displays} {altDisplay} { +test send-14.1 {SendRestrictProc procedure, sends crossing from different displays} {unixOnly altDisplay} { setupbg -display $env(TK_ALT_DISPLAY) set result [dobg " toplevel .t -screen [winfo screen .] @@ -635,28 +624,26 @@ test send-14.1 {SendRestrictProc procedure, sends crossing from different displa set result } {child parent} -if $gotTestCmds { +catch { testsend prop root InterpRegister $registry tk appname tktest - test send-15.1 {UpdateCommWindow procedure} { - set x [list [testsend prop comm TK_APPLICATION]] - newApp "" t_s_1 Test - send t_s_1 wm withdraw . - newApp "" t_s_2 Test - send t_s_2 wm withdraw . - lappend x [testsend prop comm TK_APPLICATION] - interp delete t_s_1 - lappend x [testsend prop comm TK_APPLICATION] - interp delete t_s_2 - lappend x [testsend prop comm TK_APPLICATION] - } {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest} } +test send-15.1 {UpdateCommWindow procedure} {unixOnly testsend} { + set x [list [testsend prop comm TK_APPLICATION]] + newApp "" t_s_1 Test + send t_s_1 wm withdraw . + newApp "" t_s_2 Test + send t_s_2 wm withdraw . + lappend x [testsend prop comm TK_APPLICATION] + interp delete t_s_1 + lappend x [testsend prop comm TK_APPLICATION] + interp delete t_s_2 + lappend x [testsend prop comm TK_APPLICATION] +} {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest} -tk appname $name -if $gotTestCmds { +catch { + tk appname $name testsend prop root InterpRegistry $registry -} -if $gotTestCmds { testdeleteapps } rename newApp {} @@ -664,16 +651,3 @@ rename newApp {} # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/winClipboard.test b/tests/winClipboard.test index 3c67bb7..73aaaef 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.8 2001/04/04 07:07:45 hobbs Exp $ +# RCS: @(#) $Id: winClipboard.test,v 1.9 2001/09/21 20:38:18 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -19,25 +19,22 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # Note that these tests may fail if another application is grabbing the # clipboard (e.g. an X server) -if {[llength [info command testclipboard]] == 0} { - puts "\"testclipboard\" isn't defined, skipping winClipboard tests" - ::tcltest::cleanupTests - return -} +set ::tcltest::testConfig(testclipboard) \ + [llength [info commands testclipboard]] test winClipboard-1.1 {TkSelGetSelection} {pcOnly} { 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} { +test winClipboard-1.2 {TkSelGetSelection} {pcOnly testclipboard} { clipboard clear clipboard append {} catch {selection get -selection CLIPBOARD} r1 catch {testclipboard} r2 list $r1 $r2 } {{} {}} -test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { +test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testclipboard} { clipboard clear clipboard append abcd update @@ -45,14 +42,14 @@ test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { catch {testclipboard} r2 list $r1 $r2 } {abcd abcd} -test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { +test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly 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} { +test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {pcOnly testclipboard} { clipboard clear clipboard append "line 1\u00c7\nline 2" catch {selection get -selection CLIPBOARD} r1 @@ -60,7 +57,7 @@ test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} { list $r1 $r2 } [list "line 1\u00c7\nline 2" [bytestring "line 1\u00c7\r\nline 2"]] -test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly} { +test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly testclipboard} { clipboard clear clipboard append -type OUR_ACTION "action data" clipboard append "string data" @@ -69,7 +66,7 @@ test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly} { catch {testclipboard} r2 list $r1 $r2 } [list "action data" "string data"] -test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {pcOnly} { +test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {pcOnly testclipboard} { clipboard clear clipboard append -type OUR_ACTION "new data" clipboard append "more data in string" @@ -82,16 +79,3 @@ test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {pcOnly} { # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/winDialog.test b/tests/winDialog.test index 6dbcb2d..62c1c8a 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -4,21 +4,18 @@ # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. +# Copyright (c) 1998-1999 ActiveState Corporation. # -# RCS: @(#) $Id: winDialog.test,v 1.6 2001/04/04 06:47:25 hobbs Exp $ +# RCS: @(#) $Id: winDialog.test,v 1.7 2001/09/21 20:38:18 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] } -if {[info command testwinevent] == ""} { - puts "skipping: tests require the testwinevent command" - ::tcltest::cleanupTests - return -} +set ::tcltest::testConfig(testwinevent) \ + [llength [info commands testwinevent]] -testwinevent debug 1 +catch {testwinevent debug 1} eval destroy [winfo children .] wm geometry . {} @@ -46,16 +43,16 @@ proc afterbody {} { set ::dialogresult ">30 iterations waiting on tk_dialog" return } - after 100 {afterbody} + after 150 {afterbody} return } uplevel #0 {set dialogresult [eval $command]} -} +} proc Click {button} { testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b -} +} proc GetText {button} { return [testwinevent $::tk_dialog $button WM_GETTEXT] @@ -71,7 +68,7 @@ test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} { test winDialog-2.1 {ColorDlgHookProc} {nt} { } {} -test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} { +test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent} { start {tk_getOpenFile} then { set x [GetText 2] @@ -80,7 +77,7 @@ test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} { set x } {Cancel} -test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} { +test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent} { start {tk_getSaveFile} then { set x [GetText 2] @@ -89,7 +86,7 @@ test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} { set x } {Cancel} -test winDialog-5.1 {GetFileName: no arguments} {nt} { +test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} { start {tk_getOpenFile -title Open} then { Click cancel @@ -98,7 +95,7 @@ test winDialog-5.1 {GetFileName: no arguments} {nt} { test winDialog-5.2 {GetFileName: one argument} {nt} { list [catch {tk_getOpenFile -foo} msg] $msg } {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}} -test winDialog-5.4 {GetFileName: many arguments} {nt} { +test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} { start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} then { Click cancel @@ -107,7 +104,7 @@ test winDialog-5.4 {GetFileName: many arguments} {nt} { test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} { list [catch {tk_getOpenFile -foo bar -abc} msg] $msg } {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}} -test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} { +test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} { start {tk_getOpenFile -title bar} then { Click cancel @@ -116,7 +113,7 @@ test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} { test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} { list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg } {1 {value for "-title" missing}} -test winDialog-5.8 {GetFileName: extension begins with .} {nt} { +test winDialog-5.8 {GetFileName: extension begins with .} {nt testwinevent} { # if (string[0] == '.') { # string++; # } @@ -128,7 +125,7 @@ test winDialog-5.8 {GetFileName: extension begins with .} {nt} { } string totitle $x } [string totitle [file join [pwd] bar.foo]] -test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} { +test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwinevent} { start {set x [tk_getSaveFile -defaultextension foo -title Save]} then { SetText 0x480 bar @@ -136,7 +133,7 @@ test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} { } string totitle $x } [string totitle [file join [pwd] bar.foo]] -test winDialog-5.10 {GetFileName: file types} {nt} { +test winDialog-5.10 {GetFileName: file types} {nt testwinevent} { # case FILE_TYPES: start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} @@ -151,7 +148,7 @@ test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} { list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg } {1 {bad Macintosh file type "FOO"}} -test winDialog-5.12 {GetFileName: initial directory} {nt} { +test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} { # case FILE_INITDIR: start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]} @@ -166,7 +163,7 @@ test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \ list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg } {1 {user "12x" doesn't exist}} -test winDialog-5.14 {GetFileName: initial file} {nt} { +test winDialog-5.14 {GetFileName: initial file} {nt testwinevent} { # case FILE_INITFILE: start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} @@ -184,7 +181,7 @@ append a $a append a $a append a $a append a $a -test winDialog-5.16 {GetFileName: initial file: long name} {nt} { +test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} { start {set x [tk_getSaveFile -initialfile $a -title Long]} then { Click 1 @@ -202,7 +199,7 @@ test winDialog-5.17 {GetFileName: parent} {nt} { } set x } {1} -test winDialog-5.18 {GetFileName: title} {nt} { +test winDialog-5.18 {GetFileName: title} {nt testwinevent} { # case FILE_TITLE: start {tk_getOpenFile -title Narf} @@ -210,7 +207,7 @@ test winDialog-5.18 {GetFileName: title} {nt} { Click 2 } } {0} -test winDialog-5.19 {GetFileName: no filter specified} {nt} { +test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} { # if (ofn.lpstrFilter == NULL) start {tk_getOpenFile -title Filter} @@ -237,7 +234,7 @@ test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} { destroy .t } } {} -test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} { +test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent} { # winCode = GetOpenFileName(&ofn); start {tk_getOpenFile -title Open} @@ -247,7 +244,7 @@ test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} { } set x } {&Open} -test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt} { +test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent} { # winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} @@ -257,7 +254,7 @@ test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt} { } set x } {&Save} -test winDialog-5.24 {GetFileName: convert \ to /} {nt} { +test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent} { start {set x [tk_getSaveFile -title Back]} then { SetText 0x480 "c:\\12x 457" @@ -276,7 +273,7 @@ test winDialog-8.1 {OFNHookProc} {emptyTest nt} {} {} ## because somehow the GetOpenFileName ends up a noop in the static ## build. ## -test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} { +test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt testwinevent} { start {tk_chooseDirectory} then { Click cancel @@ -285,7 +282,7 @@ test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} { test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} { list [catch {tk_chooseDirectory -foo} msg] $msg } {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} -test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} { +test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt testwinevent} { start { tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test } @@ -298,7 +295,7 @@ test winDialog-9.4 {Tk_ChooseDirectoryObjCmd:\ list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg } {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} test winDialog-9.5 {Tk_ChooseDirectoryObjCmd:\ - Tcl_GetIndexFromObj() == TCL_OK} {nt} { + Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} { start {tk_chooseDirectory -title bar} then { Click cancel @@ -308,7 +305,7 @@ test winDialog-9.6 {Tk_ChooseDirectoryObjCmd:\ valid option, but missing value} {nt} { list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg } {1 {value for "-title" missing}} -test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt} { +test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} { # case DIR_INITIAL: start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} @@ -325,7 +322,7 @@ test winDialog-9.8 {Tk_ChooseDirectoryObjCmd:\ list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg } {1 {user "12x" doesn't exist}} -testwinevent debug 0 +catch {testwinevent debug 0} # cleanup ::tcltest::cleanupTests diff --git a/tests/winFont.test b/tests/winFont.test index 5fe5a57..ca19cd0 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.5 1999/11/12 23:55:16 wart Exp $ +# RCS: @(#) $Id: winFont.test,v 1.6 2001/09/21 20:38:18 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -183,15 +183,3 @@ test winfont-7.4 {AllocFont procedure: extract info from textmetric} {pcOnly} { destroy .b ::tcltest::cleanupTests return - - - - - - - - - - - - |