diff options
Diffstat (limited to 'tk8.6/tests/fontchooser.test')
| -rw-r--r-- | tk8.6/tests/fontchooser.test | 201 |
1 files changed, 0 insertions, 201 deletions
diff --git a/tk8.6/tests/fontchooser.test b/tk8.6/tests/fontchooser.test deleted file mode 100644 index 4dad5da..0000000 --- a/tk8.6/tests/fontchooser.test +++ /dev/null @@ -1,201 +0,0 @@ -# Test the "tk::fontchooser" command -# -# Copyright (c) 2008 Pat Thoyts - -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 {*} - -# ------------------------------------------------------------------------- -# -# The remaining tests in this file are only relevant for the script -# implementation. They can be tested by sourcing the script file but -# the Tk tests are run with -singleproc 1 and doing this affects the -# result of later attempts to test the native implementations. -# -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: |