diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/winDialog.test | 382 |
1 files changed, 236 insertions, 146 deletions
diff --git a/tests/winDialog.test b/tests/winDialog.test index 80eb297..bb515af 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -70,7 +70,7 @@ proc SetText {id text} { return [testwinevent $::tk_dialog $id WM_SETTEXT $text] } -test winDialog-1.1.0 {Tk_ChooseColorObjCmd} -constraints { +test winDialog-1.1 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {tk_chooseColor} @@ -78,7 +78,7 @@ test winDialog-1.1.0 {Tk_ChooseColorObjCmd} -constraints { Click cancel } } -result {0} -test winDialog-1.1.1 {Tk_ChooseColorObjCmd} -constraints { +test winDialog-1.2 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933"]} @@ -87,7 +87,7 @@ test winDialog-1.1.1 {Tk_ChooseColorObjCmd} -constraints { } list $x $clr } -result {0 {}} -test winDialog-1.1.2 {Tk_ChooseColorObjCmd} -constraints { +test winDialog-1.3 {Tk_ChooseColorObjCmd} -constraints { testwinevent } -body { start {set clr [tk_chooseColor -initialcolor "#ff9933"]} @@ -96,9 +96,11 @@ test winDialog-1.1.2 {Tk_ChooseColorObjCmd} -constraints { } list $x $clr } -result [list 0 "#ff9933"] -test winDialog-1.1.3 {Tk_ChooseColorObjCmd: -title} -constraints { +test winDialog-1.4 {Tk_ChooseColorObjCmd: -title} -constraints { testwinevent -} -setup {unset -nocomplain a x} -body { +} -setup { + catch {unset a x} +} -body { set x {} start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]} then { @@ -110,9 +112,11 @@ test winDialog-1.1.3 {Tk_ChooseColorObjCmd: -title} -constraints { } lappend x $clr } -result [list Hello 0 "#ff9933"] -test winDialog-1.1.4 {Tk_ChooseColorObjCmd: -title} -constraints { +test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints { testwinevent -} -setup {unset -nocomplain a x} -body { +} -setup { + catch {unset a x} +} -body { set x {} start { set clr [tk_chooseColor -initialcolor "#ff9933" \ @@ -127,9 +131,11 @@ test winDialog-1.1.4 {Tk_ChooseColorObjCmd: -title} -constraints { } lappend x $clr } -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"] -test winDialog-1.1.5 {Tk_ChooseColorObjCmd: -parent} -constraints { +test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { testwinevent -} -setup {unset -nocomplain a x} -body { +} -setup { + catch {unset a x} +} -body { start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]} set x {} then { @@ -143,98 +149,135 @@ test winDialog-1.1.5 {Tk_ChooseColorObjCmd: -parent} -constraints { } list $x $clr } -result [list 1 "#ff9933"] -test winDialog-1.1.6 {Tk_ChooseColorObjCmd: -parent} -constraints { +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-2.1 {ColorDlgHookProc} {emptyTest nt} { -} {} -test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent english} { +test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints { + nt testwinevent english +} -body { start {tk_getOpenFile} then { set x [GetText cancel] Click cancel } - set x -} {Cancel} + return $x +} -result {Cancel} -test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent english} { + +test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints { + nt testwinevent english +} -body { start {tk_getSaveFile} then { set x [GetText cancel] Click cancel } - set x -} {Cancel} + return $x +} -result {Cancel} -test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} { +test winDialog-5.1 {GetFileName: no arguments} -constraints { + nt testwinevent +} -body { 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, -multiple, -parent, -title, or -typevariable}} -test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} { +} -result {0} +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, -title, or -typevariable} +test winDialog-5.3 {GetFileName: many arguments} -constraints { + nt testwinevent +} -body { 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, -multiple, -parent, -title, or -typevariable}} -test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} { +} -result {0} +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, -title, or -typevariable} +test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints { + nt testwinevent +} -body { 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 testwinevent knownBug} { +} -result {0} +test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints { + nt +} -body { + tk_getOpenFile -initialdir bar -title +} -returnCodes error -result {value for "-title" missing} +test winDialog-5.7 {GetFileName: extension begins with .} -constraints { + nt testwinevent +} -body { # if (string[0] == '.') { # string++; # } start {set x [tk_getSaveFile -defaultextension .foo -title Save]} + set msg {} then { - SetText 0x480 bar - Click ok + if {[catch {SetText 0x47C bar} msg]} { + Click cancel + } else { + Click ok + } } - string totitle $x -} [string totitle [file join [pwd] bar.foo]] -test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwinevent knownBug} { + return [string totitle $x]$msg +} -cleanup { + unset msg +} -result [string totitle [file join [pwd] bar.foo]] +test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints { + nt testwinevent +} -body { start {set x [tk_getSaveFile -defaultextension foo -title Save]} + set msg {} then { - SetText 0x480 bar - Click ok + if {[catch {SetText 0x47C bar} msg]} { + Click cancel + } else { + Click ok + } } - string totitle $x -} [string totitle [file join [pwd] bar.foo]] -test winDialog-5.10 {GetFileName: file types} {nt testwinevent} { -# case FILE_TYPES: + return [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: 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) + 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) - list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg -} {1 {bad Macintosh file type "FOO"}} + tk_getSaveFile -filetypes {{"foo" .foo FOO}} +} -returnCodes error -result {bad Macintosh file type "FOO"} if {[info exists ::env(TEMP)]} { -test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} { -# case FILE_INITDIR: +test winDialog-5.11 {GetFileName: initial directory} -constraints { + nt testwinevent +} -body { +# case FILE_INITDIR: start {set x [tk_getSaveFile \ -initialdir [file normalize $::env(TEMP)] \ @@ -242,41 +285,50 @@ test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} { then { Click ok } - set x -} [file join [file normalize $::env(TEMP)] "12x 455"] + return $x +} -result [file join [file normalize $::env(TEMP)] "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 testwinevent} { -# case FILE_INITFILE: +test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints { + nt +} -body { +# 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: start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} then { Click ok } string totitle $x -} [string totitle [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}} -test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} { +} -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) + 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 } list $dialogresult [string match "invalid filename *" $x] -} {1 1} -test winDialog-5.17 {GetFileName: parent} {nt} { -# case FILE_PARENT: +} -result {1 1} +test winDialog-5.16 {GetFileName: parent} -constraints { + nt +} -body { +# case FILE_PARENT: toplevel .t set x 0 @@ -284,151 +336,185 @@ test winDialog-5.17 {GetFileName: parent} {nt} { then { destroy .t } - set x -} {1} -test winDialog-5.18 {GetFileName: title} {nt testwinevent} { -# case FILE_TITLE: - + return $x +} -result {1} +test winDialog-5.17 {GetFileName: title} -constraints { + nt testwinevent +} -body { +# case FILE_TITLE: + start {tk_getOpenFile -title Narf} then { Click cancel } -} {0} -test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} { -# if (ofn.lpstrFilter == NULL) +} -result {0} +test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent +} -body { +# if (ofn.lpstrFilter == NULL) - start {tk_getOpenFile -title Filter} + start {tk_getOpenFile -title Filter} then { set x [GetText 0x470] Click cancel } - set x -} {All Files (*.*)} -test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} { -# if (Tk_WindowId(parent) == None) + return $x +} -result {All Files (*.*)} +test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints { + nt +} -setup { + destroy .t +} -body { +# 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} { +} -result {} +test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints { + nt +} -setup { + destroy .t +} -body { toplevel .t update start {tk_getOpenFile -parent .t -title Open} then { destroy .t } -} {} -test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent english} { -# winCode = GetOpenFileName(&ofn); - +} -result {} +test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints { + nt testwinevent english +} -body { +# winCode = GetOpenFileName(&ofn); + start {tk_getOpenFile -title Open} then { set x [GetText ok] Click cancel } - set x -} {&Open} -test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent english} { -# winCode = GetSaveFileName(&ofn); + return $x +} -result {&Open} +test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints { + nt testwinevent english +} -body { +# winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} then { set x [GetText ok] Click cancel } - set x -} {&Save} + return $x +} -result {&Save} if {[info exists ::env(TEMP)]} { -test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent knownBug} { +test winDialog-5.23 {GetFileName: convert \ to /} -constraints { + nt testwinevent +} -body { + set msg {} start {set x [tk_getSaveFile -title Back]} then { - SetText 0x480 [file nativename \ - [file join [file normalize $::env(TEMP)] "12x 457"]] - Click ok + if {[catch {SetText 0x47C [file nativename \ + [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { + Click cancel + } else { + Click ok + } } - set x -} [file join [file normalize $::env(TEMP)] "12x 457"] + return $x$msg +} -cleanup { + unset msg +} -result [file join [file normalize $::env(TEMP)] "12x 457"] } -test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} {nt} { +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 } - set x -} {0} -test winDialog-5.26 {GetFileName: file types: MakeFilter() succeeds} {nt} { + 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 } - set x -} {0} - -test winDialog-6.1 {MakeFilter} {emptyTest nt} {} {} - -test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {} - -test winDialog-8.1 {OFNHookProc} {emptyTest nt} {} {} + 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. ## -test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt testwinevent} { +test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints { + nt testwinevent +} -body { start {tk_chooseDirectory} then { Click cancel } -} {0} -test winDialog-9.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-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt testwinevent} { +} -result {0} +test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints { + nt +} -body { + tk_chooseDirectory -foo +} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} +test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints { + nt testwinevent +} -body { start { tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test } then { Click cancel } -} {0} -test winDialog-9.4 {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-9.5 {Tk_ChooseDirectoryObjCmd:\ - Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} { +} -result {0} +test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints { + nt +} -body { + tk_chooseDirectory -foo bar -abc +} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} +test winDialog-9.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} -constraints { + nt testwinevent +} -body { start {tk_chooseDirectory -title bar} then { Click cancel } -} {0} -test winDialog-9.6 {Tk_ChooseDirectoryObjCmd:\ - valid option, but missing value} {nt} { - list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg -} {1 {value for "-title" missing}} -test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} { -# case DIR_INITIAL: +} -result {0} +test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} -constraints { + nt +} -body { + tk_chooseDirectory -initialdir bar -title +} -returnCodes error -result {value for "-title" missing} +test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints { + nt testwinevent +} -body { +# case DIR_INITIAL: start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} then { Click ok } string tolower [set x] -} {c:/} -test winDialog-9.8 {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}} +} -result {c:/} +test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints { + nt +} -body { +# if (Tcl_TranslateFileName(interp, string, +# &utfDirString) == NULL) + + tk_chooseDirectory -initialdir ~12x/455 +} -returnCodes error -result {user "12x" doesn't exist} if {[testConstraint testwinevent]} { catch {testwinevent debug 0} @@ -437,3 +523,7 @@ if {[testConstraint testwinevent]} { # cleanup cleanupTests return + +# Local variables: +# mode: tcl +# End: |