diff options
Diffstat (limited to 'tests/winDialog.test')
| -rw-r--r--[-rwxr-xr-x] | tests/winDialog.test | 750 |
1 files changed, 111 insertions, 639 deletions
diff --git a/tests/winDialog.test b/tests/winDialog.test index c8c36bf..bb515af 100755..100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -7,9 +7,8 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # Copyright (c) 1998-1999 ActiveState Corporation. -package require tcltest 2.2 -namespace import ::tcltest::* -tcltest::configure {*}$argv +package require tcltest 2.1 +eval tcltest::configure $argv tcltest::loadTestedCommands if {[testConstraint testwinevent]} { @@ -22,26 +21,9 @@ testConstraint english [expr { && (([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 } @@ -49,37 +31,20 @@ proc start {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 + 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 - } + 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]} } @@ -105,12 +70,6 @@ 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 { @@ -197,15 +156,13 @@ 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} @@ -216,8 +173,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} @@ -227,7 +184,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 { @@ -238,9 +195,9 @@ test winDialog-5.2 {GetFileName: one argument} -constraints { test winDialog-5.3 {GetFileName: many arguments} -constraints { nt testwinevent } -body { - start {tk_getOpenFile -initialdir [initialdir] -parent . -title test -initialfile foo} + 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 { @@ -251,520 +208,158 @@ test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints { 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 + start {tk_getOpenFile -title bar} + then { + Click cancel + } } -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 +# if (string[0] == '.') { +# string++; +# } -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]} + start {set x [tk_getSaveFile -defaultextension .foo -title Save]} set msg {} then { - if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + if {[catch {SetText 0x47C bar} msg]} { Click cancel } else { Click ok } } - set x "[file tail $x]$msg" + return [string totitle $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"] - +} -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 { - if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} { + if {[catch {SetText 0x47C bar} msg]} { Click cancel } else { Click ok } } - set x "[file tail $x]$msg" + return [string totitle $x]$msg } -cleanup { unset msg -} -result bar.foo +} -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} - # 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)}] + then { + set x [GetText 0x470] + Click cancel } -} -result 1 + 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"} +if {[info exists ::env(TEMP)]} { test winDialog-5.11 {GetFileName: initial directory} -constraints { nt testwinevent } -body { -# case FILE_INITDIR: - unset -nocomplain x +# case FILE_INITDIR: + start {set x [tk_getSaveFile \ - -initialdir [initialdir] \ + -initialdir [file normalize $::env(TEMP)] \ -initialfile "12x 455" -title Foo]} then { - Click ok + Click ok } return $x -} -result [file join [initialdir] "12x 455"] - +} -result [file join [file normalize $::env(TEMP)] "12x 455"] +} 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.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: +# case FILE_INITFILE: start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]} then { - Click ok + Click ok } - file tail $x -} -result "12x 456" + 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} -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.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: +# 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} -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) +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 (*.*)} -} + 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 { @@ -775,7 +370,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 { @@ -787,41 +382,42 @@ 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} +if {[info exists ::env(TEMP)]} { 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]} { + if {[catch {SetText 0x47C [file nativename \ + [file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} { Click cancel } else { Click ok @@ -830,7 +426,8 @@ test winDialog-5.23 {GetFileName: convert \ to /} -constraints { return $x$msg } -cleanup { unset msg -} -result [file join [initialdir] "12x 457"] +} -result [file join [file normalize $::env(TEMP)] "12x 457"] +} test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints { nt } -body { @@ -838,7 +435,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} @@ -849,21 +446,11 @@ 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. @@ -871,12 +458,10 @@ test winDialog-8.1 {OFNHookProc} -constraints {emptyTest nt} -body {} 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 + start {tk_chooseDirectory} + then { + Click cancel + } } -result {0} test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints { nt @@ -887,10 +472,10 @@ test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints { nt testwinevent } -body { start { - tk_chooseDirectory -initialdir [initialdir] -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 { @@ -903,7 +488,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 { @@ -914,135 +499,23 @@ 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 [initialdir] -title Foo]} + start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} then { - Click ok + Click ok } string tolower [set x] -} -result [string tolower [initialdir]] +} -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} } @@ -1054,4 +527,3 @@ return # Local variables: # mode: tcl # End: - |