diff options
Diffstat (limited to 'tests/dialog.test')
-rw-r--r-- | tests/dialog.test | 75 |
1 files changed, 42 insertions, 33 deletions
diff --git a/tests/dialog.test b/tests/dialog.test index 538461b..78b6620 100644 --- a/tests/dialog.test +++ b/tests/dialog.test @@ -1,58 +1,67 @@ # This file is a Tcl script to test out Tk's "tk_dialog" command. # It is organized in the standard fashion for Tcl tests. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test test dialog-1.1 {tk_dialog command} -body { - list [catch {tk_dialog} msg] $msg -} -match glob -result {1 {wrong # args: should be "tk_dialog w title text bitmap default *"}} -test dialog-1.2 {tk_dialog command} { - list [catch {tk_dialog foo foo foo foo foo} msg] $msg -} {1 {bad window path name "foo"}} -test dialog-1.3 {tk_dialog command} { - set res [list [catch {tk_dialog .d foo foo fooBitmap foo} msg] $msg] + tk_dialog +} -match glob -returnCodes error -result {wrong # args: should be "tk_dialog w title text bitmap default *"} +test dialog-1.2 {tk_dialog command} -body { + tk_dialog foo foo foo foo foo +} -returnCodes error -result {bad window path name "foo"} +test dialog-1.3 {tk_dialog command} -body { + tk_dialog .d foo foo fooBitmap foo +} -cleanup { destroy .d - set res -} {1 {bitmap "fooBitmap" not defined}} +} -returnCodes error -result {bitmap "fooBitmap" not defined} -proc PressButton {btn} { - if {![winfo ismapped $btn]} { - update - } - event generate $btn <Enter> - event generate $btn <1> -x 5 -y 5 - event generate $btn <ButtonRelease-1> -x 5 -y 5 -} - -proc HitReturn {w} { - event generate $w <Enter> - focus -force $w - event generate $w <KeyPress> -keysym Return -} -test dialog-2.0 {tk_dialog operation} { +test dialog-2.1 {tk_dialog operation} -setup { + proc PressButton {btn} { + if {![winfo ismapped $btn]} { + update + } + event generate $btn <Enter> + event generate $btn <1> -x 5 -y 5 + event generate $btn <ButtonRelease-1> -x 5 -y 5 + } +} -body { set x [after 5000 [list set tk::Priv(button) "no response"]] after 100 PressButton .d.button0 set res [tk_dialog .d foo foo info 0 click] after cancel $x - set res -} {0} -test dialog-2.1 {tk_dialog operation} { + return $res +} -cleanup { + destroy .d +} -result {0} +test dialog-2.2 {tk_dialog operation} -setup { + proc HitReturn {w} { + event generate $w <Enter> + focus -force $w + event generate $w <KeyPress> -keysym Return + } +} -body { set x [after 5000 [list set tk::Priv(button) "no response"]] after 100 HitReturn .d set res [tk_dialog .d foo foo info 1 click default] after cancel $x - set res -} {1} -test dialog-2.2 {tk_dialog operation} { + return $res +} -cleanup { + destroy .d +} -result {1} +test dialog-2.3 {tk_dialog operation} -body { set x [after 5000 [list set tk::Priv(button) "no response"]] after 100 destroy .d set res [tk_dialog .d foo foo info 0 click] after cancel $x - set res -} {-1} + return $res +} -cleanup { + destroy .b +} -result {-1} cleanupTests return + |