diff options
Diffstat (limited to 'tests/winDialog.test')
| -rw-r--r-- | tests/winDialog.test | 193 |
1 files changed, 156 insertions, 37 deletions
diff --git a/tests/winDialog.test b/tests/winDialog.test index 6b55c3d..bb515af 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -1,3 +1,4 @@ +# -*- tcl -*- # This file is a Tcl script to test the Windows specific behavior of # the common dialog boxes. It is organized in the standard # fashion for Tcl tests. @@ -7,18 +8,19 @@ # Copyright (c) 1998-1999 ActiveState Corporation. package require tcltest 2.1 -namespace import -force tcltest::configure -namespace import -force tcltest::testsDirectory -configure -testdir [file join [pwd] [file dirname [info script]]] -configure -loadfile [file join [testsDirectory] constraints.tcl] +eval tcltest::configure $argv tcltest::loadTestedCommands -testConstraint testwinevent [llength [info commands testwinevent]] - if {[testConstraint testwinevent]} { catch {testwinevent debug 1} } +# Locale identifier LANG_ENGLISH is 0x09 +testConstraint english [expr { + [llength [info commands testwinlocale]] + && (([testwinlocale] & 0xff) == 9) +}] + proc start {arg} { set ::tk_dialog 0 set ::iter_after 0 @@ -48,37 +50,131 @@ proc afterbody {} { } proc Click {button} { + switch -exact -- $button { + ok { set button 1 } + cancel { set button 2 } + } testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b } -proc GetText {button} { - return [testwinevent $::tk_dialog $button WM_GETTEXT] +proc GetText {id} { + switch -exact -- $id { + ok { set id 1 } + cancel { set id 2 } + } + return [testwinevent $::tk_dialog $id WM_GETTEXT] } -proc SetText {button text} { - return [testwinevent $::tk_dialog $button WM_SETTEXT $text] +proc SetText {id text} { + return [testwinevent $::tk_dialog $id WM_SETTEXT $text] } +test winDialog-1.1 {Tk_ChooseColorObjCmd} -constraints { + testwinevent +} -body { + start {tk_chooseColor} + then { + Click cancel + } +} -result {0} +test winDialog-1.2 {Tk_ChooseColorObjCmd} -constraints { + testwinevent +} -body { + start {set clr [tk_chooseColor -initialcolor "#ff9933"]} + then { + set x [Click cancel] + } + list $x $clr +} -result {0 {}} +test winDialog-1.3 {Tk_ChooseColorObjCmd} -constraints { + testwinevent +} -body { + start {set clr [tk_chooseColor -initialcolor "#ff9933"]} + then { + set x [Click ok] + } + list $x $clr +} -result [list 0 "#ff9933"] +test winDialog-1.4 {Tk_ChooseColorObjCmd: -title} -constraints { + testwinevent +} -setup { + catch {unset a x} +} -body { + set x {} + start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]} + then { + if {[catch { + array set a [testgetwindowinfo $::tk_dialog] + if {[info exists a(text)]} {lappend x $a(text)} + } err]} { lappend x $err } + lappend x [Click ok] + } + lappend x $clr +} -result [list Hello 0 "#ff9933"] +test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints { + testwinevent +} -setup { + catch {unset a x} +} -body { + set x {} + start { + set clr [tk_chooseColor -initialcolor "#ff9933" \ + -title "\u041f\u0440\u0438\u0432\u0435\u0442"] + } + then { + if {[catch { + array set a [testgetwindowinfo $::tk_dialog] + if {[info exists a(text)]} {lappend x $a(text)} + } err]} { lappend x $err } + lappend x [Click ok] + } + lappend x $clr +} -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"] +test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { + testwinevent +} -setup { + catch {unset a x} +} -body { + start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]} + set x {} + then { + if {[catch { + array set a [testgetwindowinfo $::tk_dialog] + if {[info exists a(parent)]} { + append x [expr {$a(parent) == [wm frame .]}] + } + } err]} {lappend x $err} + Click ok + } + list $x $clr +} -result [list 1 "#ff9933"] +test winDialog-1.7 {Tk_ChooseColorObjCmd: -parent} -constraints { + testwinevent +} -body { + tk_chooseColor -initialcolor "#ff9933" -parent .xyzzy12 +} -returnCodes error -match glob -result {bad window path name*} + + test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints { - nt testwinevent + nt testwinevent english } -body { start {tk_getOpenFile} then { - set x [GetText 2] - Click 2 + set x [GetText cancel] + Click cancel } return $x } -result {Cancel} test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints { - nt testwinevent + nt testwinevent english } -body { start {tk_getSaveFile} then { - set x [GetText 2] - Click 2 + set x [GetText cancel] + Click cancel } return $x } -result {Cancel} @@ -95,7 +191,7 @@ test winDialog-5.2 {GetFileName: one argument} -constraints { nt } -body { tk_getOpenFile -foo -} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title} +} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} test winDialog-5.3 {GetFileName: many arguments} -constraints { nt testwinevent } -body { @@ -108,7 +204,7 @@ test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints { nt } -body { tk_getOpenFile -foo bar -abc -} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title} +} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints { nt testwinevent } -body { @@ -133,9 +229,9 @@ test winDialog-5.7 {GetFileName: extension begins with .} -constraints { set msg {} then { if {[catch {SetText 0x47C bar} msg]} { - Click 2 + Click cancel } else { - Click 1 + Click ok } } return [string totitle $x]$msg @@ -149,9 +245,9 @@ test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { set msg {} then { if {[catch {SetText 0x47C bar} msg]} { - Click 2 + Click cancel } else { - Click 1 + Click ok } } return [string totitle $x]$msg @@ -187,7 +283,7 @@ test winDialog-5.11 {GetFileName: initial directory} -constraints { -initialdir [file normalize $::env(TEMP)] \ -initialfile "12x 455" -title Foo]} then { - Click 1 + Click ok } return $x } -result [file join [file normalize $::env(TEMP)] "12x 455"] @@ -206,7 +302,7 @@ test winDialog-5.13 {GetFileName: initial file} -constraints { start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} then { - Click 1 + Click ok } string totitle $x } -result [string totitle [file join [pwd] "12x 456"]] @@ -225,7 +321,7 @@ test winDialog-5.15 {GetFileName: initial file: long name} -constraints { } x] } then { - Click 1 + Click ok } list $dialogresult [string match "invalid filename *" $x] } -result {1 1} @@ -249,7 +345,7 @@ test winDialog-5.17 {GetFileName: title} -constraints { start {tk_getOpenFile -title Narf} then { - Click 2 + Click cancel } } -result {0} test winDialog-5.18 {GetFileName: no filter specified} -constraints { @@ -260,7 +356,7 @@ test winDialog-5.18 {GetFileName: no filter specified} -constraints { start {tk_getOpenFile -title Filter} then { set x [GetText 0x470] - Click 2 + Click cancel } return $x } -result {All Files (*.*)} @@ -290,26 +386,26 @@ test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints { } } -result {} test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints { - nt testwinevent + nt testwinevent english } -body { # winCode = GetOpenFileName(&ofn); start {tk_getOpenFile -title Open} then { - set x [GetText 1] - Click 2 + set x [GetText ok] + Click cancel } return $x } -result {&Open} test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints { - nt testwinevent + nt testwinevent english } -body { # winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} then { - set x [GetText 1] - Click 2 + set x [GetText ok] + Click cancel } return $x } -result {&Save} @@ -322,9 +418,9 @@ test winDialog-5.23 {GetFileName: convert \ to /} -constraints { then { if {[catch {SetText 0x47C [file nativename \ [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { - Click 2 + Click cancel } else { - Click 1 + Click ok } } return $x$msg @@ -332,6 +428,29 @@ test winDialog-5.23 {GetFileName: convert \ to /} -constraints { unset msg } -result [file join [file normalize $::env(TEMP)] "12x 457"] } +test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints { + nt +} -body { + # MacOS type that is correct, but has embedded nulls. + + start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]} + then { + Click cancel + } + return $x +} -result {0} +test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraints { + nt +} -body { + # MacOS type that is correct, but has embedded high-bit chars. + + start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]} + then { + Click cancel + } + return $x +} -result {0} + ## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows ## because somehow the GetOpenFileName ends up a noop in the static ## build. @@ -384,7 +503,7 @@ test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints { start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} then { - Click 1 + Click ok } string tolower [set x] } -result {c:/} @@ -402,7 +521,7 @@ if {[testConstraint testwinevent]} { } # cleanup -::tcltest::cleanupTests +cleanupTests return # Local variables: |