summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>2001-09-21 20:38:18 (GMT)
committerhobbs <hobbs>2001-09-21 20:38:18 (GMT)
commita1c4d6114615a7794672fd0f929ad729f9163abe (patch)
treef44d701ac67421893fe5fa058674ea6c0e75c9ba
parenta2f22702a6337c86083ff311cfc81a90c1bf6bb0 (diff)
downloadtk-a1c4d6114615a7794672fd0f929ad729f9163abe.zip
tk-a1c4d6114615a7794672fd0f929ad729f9163abe.tar.gz
tk-a1c4d6114615a7794672fd0f929ad729f9163abe.tar.bz2
improved use of test constraints
-rw-r--r--tests/id.test12
-rw-r--r--tests/macFont.test139
-rw-r--r--tests/macMenu.test431
-rw-r--r--tests/macscrollbar.test36
-rw-r--r--tests/send.test790
-rw-r--r--tests/winClipboard.test34
-rw-r--r--tests/winDialog.test61
-rw-r--r--tests/winFont.test14
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
-
-
-
-
-
-
-
-
-
-
-
-