diff options
Diffstat (limited to 'tk8.6/tests/winDialog.test')
-rwxr-xr-x | tk8.6/tests/winDialog.test | 1057 |
1 files changed, 1057 insertions, 0 deletions
diff --git a/tk8.6/tests/winDialog.test b/tk8.6/tests/winDialog.test new file mode 100755 index 0000000..c8c36bf --- /dev/null +++ b/tk8.6/tests/winDialog.test @@ -0,0 +1,1057 @@ +# -*- 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. +# +# Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998-1999 ActiveState Corporation. + +package require tcltest 2.2 +namespace import ::tcltest::* +tcltest::configure {*}$argv +tcltest::loadTestedCommands + +if {[testConstraint testwinevent]} { + catch {testwinevent debug 1} +} + +# Locale identifier LANG_ENGLISH is 0x09 +testConstraint english [expr { + [llength [info commands testwinlocale]] + && (([testwinlocale] & 0xff) == 9) +}] + +proc vista? {{prevista 0} {postvista 1}} { + lassign [split $::tcl_platform(osVersion) .] major + return [expr {$major >= 6 ? $postvista : $prevista}] +} + +# What directory to use in initialdir tests. Old code used to use +# c:/. However, on Vista/later that is a protected directory if you +# are not running privileged. Moreover, not everyone has a drive c: +# but not having a TEMP would break a lot Windows programs +proc initialdir {} { + # file join to return in Tcl canonical format (/ separator, not \) + #return [file join $::env(TEMP)] + return [tcltest::temporaryDirectory] +} + + +proc start {arg} { + set ::tk_dialog 0 + set ::iter_after 0 + set ::dialogclass "#32770" + + after 1 $arg +} + +proc then {cmd} { + set ::command $cmd + set ::dialogresult {} + set ::testfont {} + + # Do not make the delay too short. The newer Vista dialogs take + # time to come up. Even if the testforwindow returns true, the + # controls are not ready to accept messages + after 500 afterbody + vwait ::dialogresult + return $::dialogresult +} + +proc afterbody {} { + # On Vista and later, using the new file dialogs we have to find + # the window using its title as tk_dialog will not be set at the C level + if {[vista?]} { + if {[catch {testfindwindow "" $::dialogclass} ::tk_dialog]} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} + return + } + } else { + if {$::tk_dialog == 0} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } + after 150 {afterbody} + return + } + } + uplevel #0 {set dialogresult [eval $command]} +} + +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 {id} { + switch -exact -- $id { + ok { set id 1 } + cancel { set id 2 } + } + return [testwinevent $::tk_dialog $id WM_GETTEXT] +} + +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 { + 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-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 + } + return $x +} -result {Cancel} + + +test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints { + nt testwinevent english +} -body { + start {tk_getSaveFile} + then { + set x [GetText cancel] + Click cancel + } + return $x +} -result {Cancel} + +test winDialog-5.1 {GetFileName: no arguments} -constraints { + nt testwinevent +} -body { + start {tk_getOpenFile -title Open} + then { + Click cancel + } +} -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 [initialdir] -parent . -title test -initialfile foo} + then { + Click cancel + } +} -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 {set x [tk_getOpenFile -title bar]} + set y [then { + Click cancel + }] + # Note this also tests fix for + # http://core.tcl.tk/tk/tktview/4a0451f5291b3c9168cc560747dae9264e1d2ef6 + # $x is expected to be empty + append x $y +} -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 { + start {set x [tk_getSaveFile -defaultextension .foo -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.foo + +test winDialog-5.7.1 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar + +test winDialog-5.7.2 {GetFileName: extension {} Bug 47af31bd3ac6fbbb33cde1a5bab1e756ff2a6e00 } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar + +test winDialog-5.7.3 {GetFileName: extension {} Bug 47af31bd3ac6fbbb33cde1a5bab1e756ff2a6e00 } -constraints { + nt testwinevent +} -body { + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar.c} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.c + +test winDialog-5.7.4 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + # Although the docs do not explicitly mention, -filetypes seems to + # override -defaultextension + start {set x [tk_getSaveFile -filetypes {{C .c} {Tcl .tcl}} -defaultextension {foo} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.c + +test winDialog-5.7.5 {GetFileName: extension {} } -constraints { + nt testwinevent +} -body { + # Although the docs do not explicitly mention, -filetypes seems to + # override -defaultextension + start {set x [tk_getSaveFile -filetypes {{C .c} {Tcl .tcl}} -defaultextension {} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.c + + +test winDialog-5.7.6 {GetFileName: All/extension } -constraints { + nt testwinevent +} -body { + # In 8.6.4 this combination resulted in bar.ext.ext which is bad + start {set x [tk_getSaveFile -filetypes {{All *}} -defaultextension {ext} -title Save]} + set msg {} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result bar.ext + +test winDialog-5.7.7 {tk_getOpenFile: -defaultextension} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 7 7.ext" [initialdir] + start {set x [tk_getOpenFile \ + -defaultextension ext \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 7 7" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 7 7.ext"] + +test winDialog-5.7.8 {tk_getOpenFile: -defaultextension} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 7 8.ext" [initialdir] + start {set x [tk_getOpenFile \ + -defaultextension ext \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 7 8.ext" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 7 8.ext"] + +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 { + if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + Click cancel + } else { + Click ok + } + } + set x "[file tail $x]$msg" +} -cleanup { + unset msg +} -result 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} + # XXX - currently disabled for vista style dialogs because the file + # types control has no control ID and we don't have a mechanism to + # locate it. + if {[vista?]} { + then { + Click cancel + } + return 1 + } else { + then { + set x [GetText 0x470] + Click cancel + } + return [string equal $x {foo files (*.foo)}] + } +} -result 1 +test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints { + nt +} -body { +# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) + + tk_getSaveFile -filetypes {{"foo" .foo FOO}} +} -returnCodes error -result {bad Macintosh file type "FOO"} +test winDialog-5.11 {GetFileName: initial directory} -constraints { + nt testwinevent +} -body { +# case FILE_INITDIR: + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir [initialdir] \ + -initialfile "12x 455" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "12x 455"] + +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.12.1 {tk_getSaveFile: initial directory: ~} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir ~ \ + -initialfile "5 12 1" -title Foo]} + then { + Click ok + } + return $x +} -result [file normalize [file join ~ "5 12 1"]] + +test winDialog-5.12.2 {tk_getSaveFile: initial directory: ~user} -constraints { + nt testwinevent +} -body { + + # Note: this test will fail on Tcl versions 8.6.4 and earlier due + # to a bug in file normalize for names of the form ~xxx that + # returns the wrong dir on Windows. In particular (in Win8 at + # least) it returned /users/Default instead of /users/USERNAME... + + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir ~$::tcl_platform(user) \ + -initialfile "5 12 2" -title Foo]} + then { + Click ok + } + return $x +} -result [file normalize [file join ~$::tcl_platform(user) "5 12 2"]] + +test winDialog-5.12.3 {tk_getSaveFile: initial directory: .} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set newdir [tcltest::makeDirectory "5 12 3"] + set cur [pwd] + try { + cd $newdir + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir . \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x [file join $newdir testfile] +} -result 1 + +test winDialog-5.12.4 {tk_getSaveFile: initial directory: unicode} -constraints { + nt testwinevent +} -body { + set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"] + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir $dir \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + string equal $x [file join $dir testfile] +} -result 1 + +test winDialog-5.12.5 {tk_getSaveFile: initial directory: nativename} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 12 5" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 12 5"] + +test winDialog-5.12.6 {tk_getSaveFile: initial directory: relative} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set dir [tcltest::makeDirectory "5 12 6"] + set cur [pwd] + try { + cd [file dirname $dir] + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir "5 12 6" \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x [file join $dir testfile] +} -result 1 + +test winDialog-5.12.7 {tk_getOpenFile: initial directory: ~} -constraints { + nt testwinevent +} -body { + set fn [file tail [lindex [glob -types f ~/*] 0]] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir ~ \ + -initialfile $fn -title Foo]} + then { + Click ok + } + string equal $x [file normalize [file join ~ $fn]] +} -result 1 + +test winDialog-5.12.8 {tk_getOpenFile: initial directory: .} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set newdir [tcltest::makeDirectory "5 12 8"] + set path [tcltest::makeFile "" "testfile" $newdir] + set cur [pwd] + try { + cd $newdir + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir . \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x $path +} -result 1 + +test winDialog-5.12.9 {tk_getOpenFile: initial directory: unicode} -constraints { + nt testwinevent +} -body { + set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"] + set path [tcltest::makeFile "" testfile $dir] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir $dir \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + string equal $x $path +} -result 1 + +test winDialog-5.12.10 {tk_getOpenFile: initial directory: nativename} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 12 10" [initialdir] + start {set x [tk_getOpenFile \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 12 10" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 12 10"] + +test winDialog-5.12.11 {tk_getOpenFile: initial directory: relative} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set dir [tcltest::makeDirectory "5 12 11"] + set path [tcltest::makeFile "" testfile $dir] + set cur [pwd] + try { + cd [file dirname $dir] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir [file tail $dir] \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x $path +} -result 1 + +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 + } + file tail $x +} -result "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} +if {![vista?]} { + # XXX - disabled for Vista because the new dialogs allow long file + # names to be specified but force the user to change it. + 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] + } + then { + Click ok + } + list $dialogresult [string match "invalid filename *" $x] + } -result {1 1} +} +test winDialog-5.16 {GetFileName: parent} -constraints { + nt +} -body { +# case FILE_PARENT: + + toplevel .t + set x 0 + start {tk_getOpenFile -parent .t -title Parent; set x 1} + then { + destroy .t + } + 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 + } +} -result {0} +if {[vista?]} { + # In the newer file dialogs, the file type widget does not even exist + # if no file types specified + test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent + } -body { + # if (ofn.lpstrFilter == NULL) + start {tk_getOpenFile -title Filter} + then { + catch {set x [GetText 0x470]} y + Click cancel + } + return $y + } -result {Could not find control with id 1136} +} else { + test winDialog-5.18 {GetFileName: no filter specified} -constraints { + nt testwinevent + } -body { + # if (ofn.lpstrFilter == NULL) + + start {tk_getOpenFile -title Filter} + then { + set x [GetText 0x470] + Click cancel + } + 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 + } +} -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 + } +} -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 + } + 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 + } + return $x +} -result {&Save} +test winDialog-5.23 {GetFileName: convert \ to /} -constraints { + nt testwinevent +} -body { + set msg {} + start {set x [tk_getSaveFile -title Back]} + then { + if {[catch {SetText [vista? 0x47C 0x3e9] [file nativename \ + [file join [initialdir] "12x 457"]]} msg]} { + Click cancel + } else { + Click ok + } + } + return $x$msg +} -cleanup { + unset msg +} -result [file join [initialdir] "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} + + +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. +## +test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} -constraints { + nt testwinevent +} -body { + start {set x [tk_chooseDirectory]} + set y [then { + Click cancel + }] + # $x should be "" on a Cancel + append x $y +} -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 [initialdir] -mustexist 1 -parent . -title test + } + then { + Click cancel + } +} -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 + } +} -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 [initialdir] -title Foo]} + then { + Click ok + } + string tolower [set x] +} -result [string tolower [initialdir]] +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} + + +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} +} + +# cleanup +cleanupTests +return + +# Local variables: +# mode: tcl +# End: + |