diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/fontchooser.test | 203 | ||||
| -rw-r--r-- | tests/winDialog.test | 119 |
2 files changed, 321 insertions, 1 deletions
diff --git a/tests/fontchooser.test b/tests/fontchooser.test new file mode 100644 index 0000000..0f90a46 --- /dev/null +++ b/tests/fontchooser.test @@ -0,0 +1,203 @@ +# Test the "tk::fontchooser" command +# +# Copyright (c) 2008 Pat Thoyts +# +# RCS: @(#) $Id: fontchooser.test,v 1.1 2008/12/10 05:02:52 das Exp $ +# + +package require tcltest 2.1 +eval tcltest::configure $argv +tcltest::loadTestedCommands + +# the following helper functions are related to the functions used +# in winDialog.test where they are used to send messages to the win32 +# dialog (hence the wierdness). + +proc start {cmd} { + set ::tk_dialog {} + set ::iter_after 0 + after 1 $cmd +} +proc then {cmd} { + set ::command $cmd + set ::dialogresult {} + set ::testfont {} + afterbody + vwait ::dialogresult + return $::dialogresult +} +proc afterbody {} { + if {$::tk_dialog == {}} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting for tk_dialog" + return + } + after 150 {afterbody} + return + } + uplevel #0 {set dialogresult [eval $command]} +} +proc Click {button} { + switch -exact -- $button { + ok { $::tk_dialog.ok invoke } + cancel { $::tk_dialog.cancel invoke } + apply { $::tk_dialog.apply invoke } + default { return -code error "invalid button name \"$button\"" } + } +} +proc ApplyFont {font} { +# puts stderr "apply: $font" + set ::testfont $font +} + +# ------------------------------------------------------------------------- + +test fontchooser-1.1 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser -z +} -result {unknown or ambiguous subcommand "-z": must be configure, hide, or show} + +test fontchooser-1.2 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -z +} -match glob -result {bad option "-z":*} + +test fontchooser-1.3 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -parent . -font +} -result {value for "-font" missing} + +test fontchooser-1.4 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -parent . -title +} -result {value for "-title" missing} + +test fontchooser-1.5 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -parent . -command +} -result {value for "-command" missing} + +test fontchooser-1.6 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -title . -parent +} -result {value for "-parent" missing} + +test fontchooser-1.7 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -parent abc +} -result {bad window path name "abc"} + +test fontchooser-1.8 {tk fontchooser: usage} -returnCodes ok -body { + tk fontchooser configure -visible +} -result {0} + +test fontchooser-1.9 {tk fontchooser: usage} -returnCodes error -body { + tk fontchooser configure -visible 1 +} -match glob -result {*} + +# ------------------------------------------------------------------------- +# By explicitly calling the tk internal command we always test the script +# implementation here even when the current platform defines a native +# font dialog. This is intentional in this test file. + +source [file join $tk_library fontchooser.tcl] +testConstraint scriptImpl [llength [info proc ::tk::fontchooser::Configure]] + +test fontchooser-2.0 {fontchooser -title} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -title "Hello" + tk::fontchooser::Show + } + then { + set x [wm title $::tk_dialog] + Click cancel + } + set x +} -result {Hello} + +test fontchooser-2.1 {fontchooser -title (cyrillic)} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure \ + -title "\u041f\u0440\u0438\u0432\u0435\u0442" + tk::fontchooser::Show + } + then { + set x [wm title $::tk_dialog] + Click cancel + } + set x +} -result "\u041f\u0440\u0438\u0432\u0435\u0442" + +test fontchooser-3.0 {fontchooser -parent} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -parent . + tk::fontchooser::Show + } + then { + set x [winfo parent $::tk_dialog] + Click cancel + } + set x +} -result {.} + +test fontchooser-3.1 {fontchooser -parent (invalid)} -constraints scriptImpl -body { + tk::fontchooser::Configure -parent junk +} -returnCodes error -match glob -result {bad window path *} + +test fontchooser-4.0 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font courier + tk::fontchooser::Show + } + then { + Click cancel + } + set ::testfont +} -result {} + +test fontchooser-4.1 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font courier + tk::fontchooser::Show + } + then { + Click ok + } + expr {$::testfont ne {}} +} -result {1} + +test fontchooser-4.2 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font TkDefaultFont + tk::fontchooser::Show + } + then { + Click ok + } + expr {$::testfont ne {}} +} -result {1} + +test fontchooser-4.3 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font {times 14 bold} + tk::fontchooser::Show + } + then { + Click ok + } + expr {$::testfont ne {}} +} -result {1} + +test fontchooser-4.4 {fontchooser -font} -constraints scriptImpl -body { + start { + tk::fontchooser::Configure -command ApplyFont -font {times 14 bold} + tk::fontchooser::Show + } + then { + Click ok + } + lrange $::testfont 1 end +} -result {14 bold} + +# ------------------------------------------------------------------------- + +cleanupTests +return + +# Local Variables: +# mode: tcl +# indent-tabs-mode: nil +# End: diff --git a/tests/winDialog.test b/tests/winDialog.test index 5cc6e34..3a5c347 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 1998-1999 ActiveState Corporation. # -# RCS: @(#) $Id: winDialog.test,v 1.23 2008/11/22 12:22:12 patthoyts Exp $ +# RCS: @(#) $Id: winDialog.test,v 1.24 2008/12/10 05:02:52 das Exp $ package require tcltest 2.2 namespace import ::tcltest::* @@ -34,6 +34,7 @@ proc start {arg} { proc then {cmd} { set ::command $cmd set ::dialogresult {} + set ::testfont {} afterbody vwait ::dialogresult @@ -73,6 +74,10 @@ proc SetText {id text} { return [testwinevent $::tk_dialog $id WM_SETTEXT $text] } +proc ApplyFont {font} { + set ::testfont $font +} + # ---------------------------------------------------------------------- test winDialog-1.1 {Tk_ChooseColorObjCmd} -constraints { @@ -516,6 +521,118 @@ test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFi tk_chooseDirectory -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} + +test winDialog-10.1 {Tk_FontchooserObjCmd: no arguments} -constraints { + nt testwinevent +} -body { + start {tk fontchooser show} + list [then { + Click cancel + }] $::testfont +} -result {0 {}} +test winDialog-10.2 {Tk_FontchooserObjCmd: -initialfont} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command ApplyFont -font system + tk fontchooser show + } + list [then { + Click cancel + }] $::testfont +} -result {0 {}} +test winDialog-10.3 {Tk_FontchooserObjCmd: -initialfont} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command ApplyFont -font system + tk fontchooser show + } + list [then { + Click 1 + }] [expr {[llength $::testfont] ne {}}] +} -result {0 1} +test winDialog-10.4 {Tk_FontchooserObjCmd: -title} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command ApplyFont -title "tk test" + tk fontchooser show + } + list [then { + Click cancel + }] $::testfont +} -result {0 {}} +test winDialog-10.5 {Tk_FontchooserObjCmd: -parent} -constraints { + nt testwinevent +} -setup { + array set a {parent {}} +} -body { + start { + tk fontchooser configure -command ApplyFont -parent . + tk fontchooser show + } + then { + array set a [testgetwindowinfo $::tk_dialog] + Click cancel + } + list [expr {$a(parent) == [wm frame .]}] $::testfont +} -result {1 {}} +test winDialog-10.6 {Tk_FontchooserObjCmd: -apply} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command FooBarBaz + tk fontchooser show + } + then { + Click cancel + } +} -result 0 +test winDialog-10.7 {Tk_FontchooserObjCmd: -apply} -constraints { + nt testwinevent +} -body { + start { + tk fontchooser configure -command ApplyFont -parent . + tk fontchooser show + } + list [then { + Click [expr {0x0402}] ;# value from XP + Click cancel + }] [expr {[llength $::testfont] > 0}] +} -result {0 1} +test winDialog-10.8 {Tk_FontchooserObjCmd: -title} -constraints { + nt testwinevent +} -setup { + array set a {text failed} +} -body { + start { + tk fontchooser configure -command ApplyFont -title "Hello" + tk fontchooser show + } + then { + array set a [testgetwindowinfo $::tk_dialog] + Click cancel + } + set a(text) +} -result "Hello" +test winDialog-10.9 {Tk_FontchooserObjCmd: -title} -constraints { + nt testwinevent +} -setup { + array set a {text failed} +} -body { + start { + tk fontchooser configure -command ApplyFont \ + -title "\u041f\u0440\u0438\u0432\u0435\u0442" + tk fontchooser show + } + then { + array set a [testgetwindowinfo $::tk_dialog] + Click cancel + } + set a(text) +} -result "\u041f\u0440\u0438\u0432\u0435\u0442" + if {[testConstraint testwinevent]} { catch {testwinevent debug 0} } |