summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/choosedir.test16
-rw-r--r--tests/clrpick.test4
-rw-r--r--tests/constraints.tcl3
-rw-r--r--tests/menuDraw.test6
-rw-r--r--tests/unixMenu.test8
-rw-r--r--tests/unixWm.test6
-rw-r--r--tests/winMenu.test4
7 files changed, 24 insertions, 23 deletions
diff --git a/tests/choosedir.test b/tests/choosedir.test
index d63d091..7d5d942 100644
--- a/tests/choosedir.test
+++ b/tests/choosedir.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: choosedir.test,v 1.14 2004/12/08 03:02:53 dgp Exp $
+# RCS: @(#) $Id: choosedir.test,v 1.15 2007/05/09 12:52:44 das Exp $
#
package require tcltest 2.1
@@ -100,12 +100,12 @@ test choosedir-1.3 "tk_chooseDirectory command" unix {
} {1 {bad window path name "foo.bar"}}
-test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" unix {
+test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unix notAqua} {
ToPressButton $parent cancel
tk_chooseDirectory -title "Press Cancel" -parent $parent
} ""
-test choosedir-3.1 "tk_chooseDirectory -mustexist 1" unix {
+test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unix notAqua} {
# first enter a bogus dirname, then enter a real one.
ToEnterDirsByKey $parent [list $fake $real $real]
set result [tk_chooseDirectory \
@@ -113,23 +113,23 @@ test choosedir-3.1 "tk_chooseDirectory -mustexist 1" unix {
-parent $parent -mustexist 1]
set result
} $real
-test choosedir-3.2 "tk_chooseDirectory -mustexist 0" unix {
+test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unix notAqua} {
ToEnterDirsByKey $parent [list $fake $fake]
tk_chooseDirectory -title "Enter \"$fake\", press OK" \
-parent $parent -mustexist 0
} $fake
-test choosedir-4.1 "tk_chooseDirectory command, initialdir" unix {
+test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unix notAqua} {
ToPressButton $parent ok
tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real
} $real
-test choosedir-4.2 "tk_chooseDirectory command, initialdir" unix {
+test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unix notAqua} {
ToEnterDirsByKey $parent [list $fake $fake]
tk_chooseDirectory \
-title "Enter \"$fake\" and press Ok" \
-parent $parent -initialdir $real
} $fake
-test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" unix {
+test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unix notAqua} {
catch {unset ::tk::dialog::file::__tk_choosedir}
ToPressButton $parent ok
tk_chooseDirectory \
@@ -137,7 +137,7 @@ test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" unix {
-parent $parent -initialdir ""
} [pwd]
-test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" unix {
+test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unix notAqua} {
ToEnterDirsByKey $parent [list "" $real $real]
tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \
-parent $parent
diff --git a/tests/clrpick.test b/tests/clrpick.test
index 341a6de..874a532 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: clrpick.test,v 1.12 2004/06/24 12:45:42 dkf Exp $
+# RCS: @(#) $Id: clrpick.test,v 1.13 2007/05/09 12:52:44 das Exp $
#
package require tcltest 2.1
@@ -192,7 +192,7 @@ test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} {
tk_chooseColor -parent $parent -title "Press Cancel"
} ""
-test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} unix {
+test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} {unix notAqua} {
after 50 {set ::scr [winfo screen .__tk__color]}
ToPressButton $parent cancel
tk_chooseColor -parent $parent
diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 3b786d9..a3a6af3 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -148,7 +148,8 @@ testConstraint notAqua [expr {[tk windowingsystem] ne "aqua"}]
testConstraint aqua [expr {[tk windowingsystem] eq "aqua"}]
testConstraint userInteraction 0
testConstraint nonUnixUserInteraction [expr {
- [testConstraint userInteraction] || [testConstraint unix]
+ [testConstraint userInteraction] ||
+ ([testConstraint unix] && [testConstraint notAqua])
}]
testConstraint haveDISPLAY [info exists env(DISPLAY)]
testConstraint altDisplay [info exists env(TK_ALT_DISPLAY)]
diff --git a/tests/menuDraw.test b/tests/menuDraw.test
index f4122f1..0e47a62 100644
--- a/tests/menuDraw.test
+++ b/tests/menuDraw.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menuDraw.test,v 1.9 2004/06/24 12:45:43 dkf Exp $
+# RCS: @(#) $Id: menuDraw.test,v 1.10 2007/05/09 12:52:44 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -422,7 +422,7 @@ test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} {
} {0 {}}
-test menuDraw-16.1 {TkPostSubmenu} unix {
+test menuDraw-16.1 {TkPostSubmenu} nonUnixUserInteraction {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -433,7 +433,7 @@ test menuDraw-16.1 {TkPostSubmenu} unix {
$tearoff postcascade 0
list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
} {{} {} {}}
-test menuDraw-16.2 {TkPostSubMenu} unix {
+test menuDraw-16.2 {TkPostSubMenu} nonUnixUserInteraction {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
diff --git a/tests/unixMenu.test b/tests/unixMenu.test
index 6229d6f..a56b62e 100644
--- a/tests/unixMenu.test
+++ b/tests/unixMenu.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixMenu.test,v 1.9 2004/06/24 12:45:44 dkf Exp $
+# RCS: @(#) $Id: unixMenu.test,v 1.10 2007/05/09 12:52:44 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -303,7 +303,7 @@ test unixMenu-17.1 {GetMenuSeparatorGeometry} unix {
list [catch {tk::TearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
-test unixMenu-18.1 {GetTearoffEntryGeometry} unix {
+test unixMenu-18.1 {GetTearoffEntryGeometry} {unix nonUnixUserInteraction} {
catch {destroy .m1}
menubutton .mb -text "test" -menu .mb.m
menu .mb.m
@@ -553,7 +553,7 @@ test unixMenu-20.1 {DrawTearoffEntry - menubar} unix {
. configure -menu .m1
list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test unixMenu-20.2 {DrawTearoffEntry - non-menubar} unix {
+test unixMenu-20.2 {DrawTearoffEntry - non-menubar} {unix nonUnixUserInteraction} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
@@ -819,7 +819,7 @@ test unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} unix {
.m1 add separator
list [update idletasks] [destroy .m1]
} {{} {}}
-test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} unix {
+test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unix nonUnixUserInteraction} {
catch {destroy .m1}
menubutton .mb -text "test" -menu .mb.m
menu .mb.m
diff --git a/tests/unixWm.test b/tests/unixWm.test
index fcce160..c749efa 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixWm.test,v 1.41 2005/11/16 02:51:38 jenglish Exp $
+# RCS: @(#) $Id: unixWm.test,v 1.42 2007/05/09 12:52:44 das Exp $
package require tcltest 2.2
eval tcltest::configure $argv
@@ -2158,7 +2158,7 @@ test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} unix {
wm colormap .t
} {}
-test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} unix {
+test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} {unix nonUnixUserInteraction} {
catch {destroy .t}
catch {destroy .m}
toplevel .t -width 300 -height 200 -bd 2 -relief raised
@@ -2175,7 +2175,7 @@ test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} unix {
destroy .m
set x
} {no event}
-test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} unix {
+test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} {unix nonUnixUserInteraction} {
catch {destroy .m}
menu .m
.m add command -label First
diff --git a/tests/winMenu.test b/tests/winMenu.test
index 01ed0c5..ff3296b 100644
--- a/tests/winMenu.test
+++ b/tests/winMenu.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winMenu.test,v 1.9 2004/06/24 12:45:44 dkf Exp $
+# RCS: @(#) $Id: winMenu.test,v 1.10 2007/05/09 12:52:44 das Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -879,7 +879,7 @@ test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} win {
.m1 add separator
list [update idletasks] [destroy .m1]
} {{} {}}
-test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} unix {
+test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unix nonUnixUserInteraction} {
catch {destroy .m1}
menubutton .mb -text "test" -menu .mb.m
menu .mb.m
generated by cgit v0.12 at 2024-12-25 18:15:55 (GMT)