diff options
author | donal.k.fellows@manchester.ac.uk <dkf> | 2004-05-23 17:34:48 (GMT) |
---|---|---|
committer | donal.k.fellows@manchester.ac.uk <dkf> | 2004-05-23 17:34:48 (GMT) |
commit | 0b91402efd4f090b076ac7f71ed939ed664400b2 (patch) | |
tree | c1834b8cace8654026ee20f8fd75ea3f340a902c /tests/msgbox.test | |
parent | 08844409ecd112b5d70f7c06e5a05b015e3022c4 (diff) | |
download | tk-0b91402efd4f090b076ac7f71ed939ed664400b2.zip tk-0b91402efd4f090b076ac7f71ed939ed664400b2.tar.gz tk-0b91402efd4f090b076ac7f71ed939ed664400b2.tar.bz2 |
First step towards improving test style. Also start using Tcl 8.5 features.
Diffstat (limited to 'tests/msgbox.test')
-rw-r--r-- | tests/msgbox.test | 34 |
1 files changed, 15 insertions, 19 deletions
diff --git a/tests/msgbox.test b/tests/msgbox.test index fb07c80..2959ccd 100644 --- a/tests/msgbox.test +++ b/tests/msgbox.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: msgbox.test,v 1.7 2003/04/01 21:06:47 dgp Exp $ +# RCS: @(#) $Id: msgbox.test,v 1.8 2004/05/23 17:34:49 dkf Exp $ # package require tcltest 2.1 @@ -24,10 +24,10 @@ regsub -all , $msg "" options regsub \"-foo\" $options "" options foreach option $options { - if {[string index $option 0] == "-"} { - test msgbox-1.3 {tk_messageBox command} { - list [catch {tk_messageBox $option} msg] $msg - } [list 1 "value for \"$option\" missing"] + if {[string index $option 0] eq "-"} { + test msgbox-1.3$option {tk_messageBox command} -body { + tk_messageBox $option + } -returnCodes error -result "value for \"$option\" missing" } } @@ -67,11 +67,7 @@ test msgbox-1.10 {tk_messageBox command} { list [catch {tk_messageBox -parent foo.bar} msg] $msg } {1 {bad window path name "foo.bar"}} -if {[info commands tk::MessageBox] == ""} { - set isNative 1 -} else { - set isNative 0 -} +set isNative [expr {[info commands tk::MessageBox] == ""}] proc ChooseMsg {parent btn} { global isNative @@ -133,35 +129,35 @@ foreach spec $specs { set buttons [lindex $spec 3] set button [lindex $buttons 0] - test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} { + test msgbox-2.$count {tk_messageBox command} nonUnixUserInteraction { ChooseMsg $parent $button tk_messageBox -title Hi -message "Please press $button" \ - -type $type + -type $type } $button incr count foreach icon {warning error info question} { test msgbox-2.$count {tk_messageBox command -icon option} \ - {nonUnixUserInteraction} { + nonUnixUserInteraction { ChooseMsg $parent $button tk_messageBox -title Hi -message "Please press $button" \ - -type $type -icon $icon + -type $type -icon $icon } $button incr count } foreach button $buttons { - test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} { + test msgbox-2.$count {tk_messageBox command} nonUnixUserInteraction { ChooseMsg $parent $button tk_messageBox -title Hi -message "Please press $button" \ - -type $type -default $button + -type $type -default $button } "$button" incr count } } # These tests will hang your test suite if they fail. -test msgbox-3.1 {tk_messageBox handles withdrawn parent} {nonUnixUserInteraction} { +test msgbox-3.1 {tk_messageBox handles withdrawn parent} nonUnixUserInteraction { wm withdraw . ChooseMsg . "ok" tk_messageBox -title Hi -message "Please press ok" \ @@ -169,13 +165,13 @@ test msgbox-3.1 {tk_messageBox handles withdrawn parent} {nonUnixUserInteraction } "ok" wm deiconify . -test msgbox-3.2 {tk_messageBox handles iconified parent} {nonUnixUserInteraction} { +test msgbox-3.2 {tk_messageBox handles iconified parent} nonUnixUserInteraction { wm iconify . ChooseMsg . "ok" tk_messageBox -title Hi -message "Please press ok" \ -type ok -default ok } "ok" -wm deiconify . +wm deiconify . # cleanup cleanupTests |