From b7ca14476921fec908be93647b91fe3947b5f824 Mon Sep 17 00:00:00 2001 From: das Date: Wed, 9 May 2007 12:52:44 +0000 Subject: * tests/constraints.tcl: ensure 'nonUnixUserInteraction' constraint is set for aqua. * tests/choosedir.test: add 'notAqua' constraints to X11-only tests; * tests/clrpick.test: add 'nonUnixUserInteraction' to 'unix' tests * tests/menuDraw.test: requiring interaction on aqua. * tests/unixMenu.test: * tests/unixWm.test: * tests/winMenu.test: --- tests/choosedir.test | 16 ++++++++-------- tests/clrpick.test | 4 ++-- tests/constraints.tcl | 3 ++- tests/menuDraw.test | 6 +++--- tests/unixMenu.test | 8 ++++---- tests/unixWm.test | 6 +++--- tests/winMenu.test | 4 ++-- 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 -- cgit v0.12