diff options
Diffstat (limited to 'tests/winDialog.test')
| -rw-r--r-- | tests/winDialog.test | 335 |
1 files changed, 335 insertions, 0 deletions
diff --git a/tests/winDialog.test b/tests/winDialog.test new file mode 100644 index 0000000..64ed21b --- /dev/null +++ b/tests/winDialog.test @@ -0,0 +1,335 @@ +# 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. +# +# Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: winDialog.test,v 1.2 1999/04/16 01:51:43 stanton Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +if {[info command testwinevent] == ""} { + puts "skipping: tests require the testwinevent command" + ::tcltest::cleanupTests + return +} + +testwinevent debug 1 + +eval destroy [winfo children .] +wm geometry . {} +raise . + +proc start {arg} { + set ::tk_dialog 0 + + after 1 "$arg" +} + +proc then {cmd} { + set ::command $cmd + set ::dialogresult {} + + afterbody + vwait ::dialogresult + return $::dialogresult +} + +proc afterbody {} { + if {$::tk_dialog == 0} { + after 100 {afterbody} + return + } + uplevel #0 {set dialogresult [eval $command]} +} + +proc Click {button} { + 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 SetText {button text} { + return [testwinevent $::tk_dialog $button WM_SETTEXT $text] +} + +test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} { +} {} + +test winDialog-2.1 {ColorDlgHookProc} {nt} { +} {} + +test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} { + start {tk_getOpenFile} + then { + set x [GetText 2] + Click 2 + } + set x +} {Cancel} + +test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} { + start {tk_getSaveFile} + then { + set x [GetText 2] + Click 2 + } + set x +} {Cancel} + +test winDialog-5.1 {GetFileName: no arguments} {nt} { + start {tk_getOpenFile -title Open} + then { + Click cancel + } +} {0} +test winDialog-5.2 {GetFileName: one argument} {nt} { + list [catch {tk_getOpenFile -foo} msg] $msg +} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}} +test winDialog-5.4 {GetFileName: many arguments} {nt} { + start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo} + then { + Click cancel + } +} {0} +test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} { + list [catch {tk_getOpenFile -foo bar -abc} msg] $msg +} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}} +test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} { + start {tk_getOpenFile -title bar} + then { + Click cancel + } +} {0} +test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} { + list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg +} {1 {value for "-title" missing}} +test winDialog-5.8 {GetFileName: extension begins with .} {nt} { +# if (string[0] == '.') { +# string++; +# } + + start {set x [tk_getSaveFile -defaultextension .foo -title Save]} + then { + SetText 0x480 bar + Click 1 + } + set x +} [file join [pwd] bar.foo] +test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} { + start {set x [tk_getSaveFile -defaultextension foo -title Save]} + then { + SetText 0x480 bar + Click 1 + } + set x +} [file join [pwd] bar.foo] +test winDialog-5.10 {GetFileName: file types} {nt} { +# case FILE_TYPES: + + start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo} + then { + set x [GetText 0x470] + Click cancel + } + set x +} {foo files (*.foo)} +test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} { +# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) + + list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg +} {1 {bad Macintosh file type "FOO"}} +test winDialog-5.12 {GetFileName: initial directory} {nt} { +# case FILE_INITDIR: + + start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]} + then { + Click 1 + } + set x +} {C:/12x 455} +test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \ + {nt} { +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + + list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg +} {1 {user "12x" doesn't exist}} +test winDialog-5.14 {GetFileName: initial file} {nt} { +# case FILE_INITFILE: + + start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} + then { + Click 1 + } + set x +} [file join [pwd] "12x 456"] +test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} { +# if (Tcl_TranslateFileName(interp, string, &ds) == NULL) + list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg +} {1 {user "12x" doesn't exist}} +set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa +append a $a +append a $a +append a $a +append a $a +test winDialog-5.16 {GetFileName: initial file: long name} {knownBug nt} { + start {set x [tk_getSaveFile -initialfile $a -title Long]} + then { + Click 1 + } + set x +} [string range [file join [pwd] $a] 0 257] +test winDialog-5.17 {GetFileName: parent} {nt} { +# case FILE_PARENT: + + toplevel .t + set x 0 + start {tk_getOpenFile -parent .t -title Parent; set x 1} + then { + destroy .t + } + set x +} {1} +test winDialog-5.18 {GetFileName: title} {nt} { +# case FILE_TITLE: + + start {tk_getOpenFile -title Narf} + then { + Click 2 + } +} {0} +test winDialog-5.19 {GetFileName: no filter specified} {nt} { +# if (ofn.lpstrFilter == NULL) + + start {tk_getOpenFile -title Filter} + then { + set x [GetText 0x470] + Click 2 + } + set x +} {All Files (*.*)} +test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} { +# if (Tk_WindowId(parent) == None) + + toplevel .t + start {tk_getOpenFile -parent .t -title Open} + then { + destroy .t + } +} {} +test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} { + toplevel .t + update + start {tk_getOpenFile -parent .t -title Open} + then { + destroy .t + } +} {} +test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} { +# winCode = GetOpenFileName(&ofn); + + start {tk_getOpenFile -title Open} + then { + set x [GetText 1] + Click 2 + } + set x +} {&Open} +test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} { +# winCode = GetSaveFileName(&ofn); + + start {tk_getSaveFile -title Save} + then { + set x [GetText 1] + Click 2 + } + set x +} {&Save} +test winDialog-5.22 {GetFileName: convert \ to /} {nt} { + start {set x [tk_getSaveFile -title Back]} + then { + SetText 0x480 "c:\\12x 457" + Click 1 + } + set x +} {c:/12x 457} + +test winDialog-8.1 {OFNHookProc} {nt} { +} {} + +test winDialog-6.1 {MakeFilter} {nt} { +} {} + +test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} { + start {tk_chooseDirectory} + then { + Click cancel + } +} {0} +test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} { + list [catch {tk_chooseDirectory -foo} msg] $msg +} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} +test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} { + start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test} + then { + Click cancel + } +} {0} +test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} \ + {nt} { + list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg +} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} +test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} \ + {nt} { + start {tk_chooseDirectory -title bar} + then { + Click cancel + } +} {0} +test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} \ + {nt} { + list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg +} {1 {value for "-title" missing}} +test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} { +# case DIR_INITIAL: + + start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} + then { + Click 1 + } + string tolower [set x] +} {c:/} +test winDialog-5.13 \ + {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} \ + {nt} { +# if (Tcl_TranslateFileName(interp, string, +# &utfDirString) == NULL) + + list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg +} {1 {user "12x" doesn't exist}} + +test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {} + +testwinevent debug 0 + +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + |