diff options
Diffstat (limited to 'tests/winDialog.test')
| -rw-r--r-- | tests/winDialog.test | 251 |
1 files changed, 192 insertions, 59 deletions
diff --git a/tests/winDialog.test b/tests/winDialog.test index bb515af..8aa9ac3 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -7,8 +7,9 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 1998-1999 ActiveState Corporation. -package require tcltest 2.1 -eval tcltest::configure $argv +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv tcltest::loadTestedCommands if {[testConstraint testwinevent]} { @@ -31,6 +32,7 @@ proc start {arg} { proc then {cmd} { set ::command $cmd set ::dialogresult {} + set ::testfont {} afterbody vwait ::dialogresult @@ -39,12 +41,12 @@ proc then {cmd} { proc afterbody {} { if {$::tk_dialog == 0} { - if {[incr ::iter_after] > 30} { - set ::dialogresult ">30 iterations waiting on tk_dialog" - return - } - after 150 {afterbody} - return + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} + return } uplevel #0 {set dialogresult [eval $command]} } @@ -70,6 +72,12 @@ 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 { testwinevent } -body { @@ -156,13 +164,15 @@ test winDialog-1.7 {Tk_ChooseColorObjCmd: -parent} -constraints { } -returnCodes error -match glob -result {bad window path name*} +test winDialog-2.1 {ColorDlgHookProc} -constraints {emptyTest nt} -body {} + test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints { nt testwinevent english } -body { start {tk_getOpenFile} then { - set x [GetText cancel] - Click cancel + set x [GetText cancel] + Click cancel } return $x } -result {Cancel} @@ -173,8 +183,8 @@ test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints { } -body { start {tk_getSaveFile} then { - set x [GetText cancel] - Click cancel + set x [GetText cancel] + Click cancel } return $x } -result {Cancel} @@ -184,7 +194,7 @@ test winDialog-5.1 {GetFileName: no arguments} -constraints { } -body { start {tk_getOpenFile -title Open} then { - Click cancel + Click cancel } } -result {0} test winDialog-5.2 {GetFileName: one argument} -constraints { @@ -197,7 +207,7 @@ test winDialog-5.3 {GetFileName: many arguments} -constraints { } -body { start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} then { - Click cancel + Click cancel } } -result {0} test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints { @@ -210,7 +220,7 @@ test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints { } -body { start {tk_getOpenFile -title bar} then { - Click cancel + Click cancel } } -result {0} test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints { @@ -222,7 +232,7 @@ test winDialog-5.7 {GetFileName: extension begins with .} -constraints { nt testwinevent } -body { # if (string[0] == '.') { -# string++; +# string++; # } start {set x [tk_getSaveFile -defaultextension .foo -title Save]} @@ -234,7 +244,7 @@ test winDialog-5.7 {GetFileName: extension begins with .} -constraints { Click ok } } - return [string totitle $x]$msg + string totitle $x$msg } -cleanup { unset msg } -result [string totitle [file join [pwd] bar.foo]] @@ -250,26 +260,26 @@ test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { Click ok } } - return [string totitle $x]$msg + string totitle $x$msg } -cleanup { unset msg } -result [string totitle [file join [pwd] bar.foo]] test winDialog-5.9 {GetFileName: file types} -constraints { nt testwinevent } -body { -# case FILE_TYPES: +# case FILE_TYPES: start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} then { - set x [GetText 0x470] - Click cancel + set x [GetText 0x470] + Click cancel } return $x } -result {foo files (*.foo)} test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints { nt } -body { -# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) +# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) tk_getSaveFile -filetypes {{"foo" .foo FOO}} } -returnCodes error -result {bad Macintosh file type "FOO"} @@ -277,13 +287,13 @@ if {[info exists ::env(TEMP)]} { test winDialog-5.11 {GetFileName: initial directory} -constraints { nt testwinevent } -body { -# case FILE_INITDIR: +# case FILE_INITDIR: start {set x [tk_getSaveFile \ -initialdir [file normalize $::env(TEMP)] \ -initialfile "12x 455" -title Foo]} then { - Click ok + Click ok } return $x } -result [file join [file normalize $::env(TEMP)] "12x 455"] @@ -291,61 +301,61 @@ test winDialog-5.11 {GetFileName: initial directory} -constraints { test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { -# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) tk_getOpenFile -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} test winDialog-5.13 {GetFileName: initial file} -constraints { nt testwinevent } -body { -# case FILE_INITFILE: +# case FILE_INITFILE: start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} then { - Click ok + Click ok } string totitle $x } -result [string totitle [file join [pwd] "12x 456"]] test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints { nt } -body { -# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) tk_getOpenFile -initialfile ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} test winDialog-5.15 {GetFileName: initial file: long name} -constraints { nt testwinevent } -body { start { - set dialogresult [catch { - tk_getSaveFile -initialfile [string repeat a 1024] -title Long - } x] + set dialogresult [catch { + tk_getSaveFile -initialfile [string repeat a 1024] -title Long + } x] } then { - Click ok + Click ok } list $dialogresult [string match "invalid filename *" $x] } -result {1 1} test winDialog-5.16 {GetFileName: parent} -constraints { nt } -body { -# case FILE_PARENT: +# case FILE_PARENT: toplevel .t set x 0 start {tk_getOpenFile -parent .t -title Parent; set x 1} then { - destroy .t + destroy .t } return $x } -result {1} test winDialog-5.17 {GetFileName: title} -constraints { nt testwinevent } -body { -# case FILE_TITLE: - +# case FILE_TITLE: + start {tk_getOpenFile -title Narf} then { - Click cancel + Click cancel } } -result {0} test winDialog-5.18 {GetFileName: no filter specified} -constraints { @@ -355,8 +365,8 @@ test winDialog-5.18 {GetFileName: no filter specified} -constraints { start {tk_getOpenFile -title Filter} then { - set x [GetText 0x470] - Click cancel + set x [GetText 0x470] + Click cancel } return $x } -result {All Files (*.*)} @@ -370,7 +380,7 @@ test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints { toplevel .t start {tk_getOpenFile -parent .t -title Open} then { - destroy .t + destroy .t } } -result {} test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints { @@ -382,30 +392,30 @@ test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints { update start {tk_getOpenFile -parent .t -title Open} then { - destroy .t + destroy .t } } -result {} test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints { nt testwinevent english } -body { -# winCode = GetOpenFileName(&ofn); - +# winCode = GetOpenFileName(&ofn); + start {tk_getOpenFile -title Open} then { - set x [GetText ok] - Click cancel + set x [GetText ok] + Click cancel } return $x } -result {&Open} test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints { nt testwinevent english } -body { -# winCode = GetSaveFileName(&ofn); +# winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} then { - set x [GetText ok] - Click cancel + set x [GetText ok] + Click cancel } return $x } -result {&Save} @@ -435,7 +445,7 @@ test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraint start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]} then { - Click cancel + Click cancel } return $x } -result {0} @@ -446,11 +456,21 @@ test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraint start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]} then { - Click cancel + Click cancel } return $x } -result {0} + +test winDialog-6.1 {MakeFilter} -constraints {emptyTest nt} -body {} + + +test winDialog-7.1 {Tk_MessageBoxObjCmd} -constraints {emptyTest nt} -body {} + + +test winDialog-8.1 {OFNHookProc} -constraints {emptyTest nt} -body {} + + ## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows ## because somehow the GetOpenFileName ends up a noop in the static ## build. @@ -460,7 +480,7 @@ test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints { } -body { start {tk_chooseDirectory} then { - Click cancel + Click cancel } } -result {0} test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints { @@ -472,10 +492,10 @@ test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints { nt testwinevent } -body { start { - tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test + tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test } then { - Click cancel + Click cancel } } -result {0} test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints { @@ -488,7 +508,7 @@ test winDialog-9.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} - } -body { start {tk_chooseDirectory -title bar} then { - Click cancel + Click cancel } } -result {0} test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} -constraints { @@ -499,23 +519,135 @@ test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} - test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints { nt testwinevent } -body { -# case DIR_INITIAL: +# case DIR_INITIAL: start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} then { - Click ok + Click ok } string tolower [set x] } -result {c:/} test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { -# if (Tcl_TranslateFileName(interp, string, -# &utfDirString) == NULL) - +# if (Tcl_TranslateFileName(interp, string, +# &utfDirString) == NULL) + 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} } @@ -527,3 +659,4 @@ return # Local variables: # mode: tcl # End: + |