summaryrefslogtreecommitdiffstats
path: root/tests/msgbox.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-05-23 17:34:48 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-05-23 17:34:48 (GMT)
commit7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba (patch)
treec1834b8cace8654026ee20f8fd75ea3f340a902c /tests/msgbox.test
parentfc07382fecf576d43fc28117ca52416170fb0f4f (diff)
downloadtk-7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba.zip
tk-7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba.tar.gz
tk-7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba.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.test34
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