diff options
Diffstat (limited to 'tests/filebox.test')
| -rw-r--r-- | tests/filebox.test | 165 |
1 files changed, 86 insertions, 79 deletions
diff --git a/tests/filebox.test b/tests/filebox.test index cd655e9..6e5b6b6 100644 --- a/tests/filebox.test +++ b/tests/filebox.test @@ -1,59 +1,35 @@ # This file is a Tcl script to test out Tk's "tk_getOpenFile" and -# "tk_getSaveFile" commands. It is organized in the standard fashion -# for Tcl tests. +# "tk_getSaveFile" commands. # # Copyright © 1996 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. -package require tcltest 2.2 -eval tcltest::configure $argv -tcltest::loadTestedCommands +# +# TESTFILE INITIALIZATION +# -# Import utility procs for specific functional areas -testutils import dialog +package require tcltest 2.2; # needed in mode -singleproc 0 -test fileDialog-0.1 {GetFileName: file types: MakeFilter() fails} { - # MacOS type that is too long +# Load the main script main.tcl, which takes care of: +# - setup for the application and the root window +# - importing commands from the tcltest namespace +# - loading of the testutils mechanism along with its utility procs +# - loading of Tk specific test constraints (additionally to constraints +# provided by the package tcltest) +source [file join [tcltest::configure -testdir] main.tcl] - set res [list [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0\0}}}} msg] $msg] - regsub -all "\0" $res {\\0} -} {1 {bad Macintosh file type "\0\0\0\0\0"}} -test fileDialog-0.2 {GetFileName: file types: MakeFilter() fails} { - # MacOS type that is too short, but looks ok in utf (4 bytes). +# Ensure a pristine initial window state +resetWindows - set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0}}}} msg] - regsub -all "\0" $msg {\\0} msg - list $x $msg -} {1 {bad Macintosh file type "\0\0"}} -# The next test must actually open a file dialog window, but it does -# not require human interaction to close the dialog because the Aqua -# port of tktest automatically closes every file dialog after a short -# timeout when tests are being run. -test fileDialog-0.3 {GetFileName: file types: bad filetype} \ --constraints aqua \ --body { - # Checks for the Aqua crash reported in ticket 080a28104. - set filename [tk_getOpenFile -filetypes { - {"Invalid extension" {x.y}} - {"All files" {*}} - }] -} \ --result {} +# Import utility procs for specific functional areas +testutils import dialog set tk_strictMotif_old $tk_strictMotif -#---------------------------------------------------------------------- # -# Procedures needed by this test file +# LOCAL UTILITY PROCS # -#---------------------------------------------------------------------- - -proc ToEnterFileByKey {parent fileName fileDir} { - if {! $::dialogIsNative} { - after 100 EnterFileByKey $parent [list $fileName] [list $fileDir] - } -} proc EnterFileByKey {parent fileName fileDir} { global tk_strictMotif @@ -76,17 +52,15 @@ proc EnterFileByKey {parent fileName fileDir} { SendButtonPress $parent ok mouse } -#---------------------------------------------------------------------- +proc ToEnterFileByKey {parent fileName fileDir} { + if {! $::dialogIsNative} { + after 100 EnterFileByKey $parent [list $fileName] [list $fileDir] + } +} + # -# The test suite proper +# COMMON TEST SETUP # -#---------------------------------------------------------------------- - -if {$tcl_platform(platform) == "unix"} { - set modes "0 1" -} else { - set modes 1 -} set unknownOptionsMsg(tk_getOpenFile,notAqua) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable} set unknownOptionsMsg(tk_getOpenFile,aqua) {bad option "-foo": must be -command, -defaultextension, -filetypes, -initialdir, -initialfile, -message, -multiple, -parent, -title, or -typevariable} @@ -117,14 +91,56 @@ array set filters { } } +set parent . +set verylongstring [string repeat longstring: 16] + +# +# TESTS +# + +test fileDialog-0.1 {GetFileName: file types: MakeFilter() fails} { + # MacOS type that is too long + + set res [list [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0\0}}}} msg] $msg] + regsub -all "\0" $res {\\0} +} {1 {bad Macintosh file type "\0\0\0\0\0"}} +test fileDialog-0.2 {GetFileName: file types: MakeFilter() fails} { + # MacOS type that is too short, but looks ok in utf (4 bytes). + + set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0}}}} msg] + regsub -all "\0" $msg {\\0} msg + list $x $msg +} {1 {bad Macintosh file type "\0\0"}} +# The next test must actually open a file dialog window, but it does +# not require human interaction to close the dialog because the Aqua +# port of tktest automatically closes every file dialog after a short +# timeout when tests are being run. +test fileDialog-0.3 {GetFileName: file types: bad filetype} \ +-constraints aqua \ +-body { + # Checks for the Aqua crash reported in ticket 080a28104. + set filename [tk_getOpenFile -filetypes { + {"Invalid extension" {x.y}} + {"All files" {*}} + }] +} \ +-result {} + +# Test both the motif version and the "tk" version of the file dialog +# box on Unix. +# +# Note that this means that test names are unusually complex. +# +if {$tcl_platform(platform) eq "unix"} { + set modes "0 1" +} else { + set modes 1 +} foreach mode $modes { + # - # Test both the motif version and the "tk" version of the file dialog - # box on Unix. - # - # Note that this means that test names are unusually complex. + # COMMON TEST SETUP # - set addedExtensions {} if {$tcl_platform(platform) == "unix"} { set tk_strictMotif $mode @@ -170,24 +186,14 @@ foreach mode $modes { tk_getOpenFile -filetypes {Foo} } -returnCodes error -result {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"} - set parent . - - set verylongstring longstring: - set verylongstring $verylongstring$verylongstring - set verylongstring $verylongstring$verylongstring - set verylongstring $verylongstring$verylongstring - set verylongstring $verylongstring$verylongstring - # set verylongstring $verylongstring$verylongstring - # set verylongstring $verylongstring$verylongstring - # set verylongstring $verylongstring$verylongstring - # set verylongstring $verylongstring$verylongstring - # set verylongstring $verylongstring$verylongstring - test filebox-2.1-$mode "tk_getOpenFile command" nonUnixUserInteraction { ToPressButton $parent cancel tk_getOpenFile -title "Press Cancel ($verylongstring)" -parent $parent } "" + # + # COMMON TEST SETUP + # set fileName $tmpFile set fileDir [tcltest::temporaryDirectory] set pathName [file join $fileDir $fileName] @@ -239,14 +245,14 @@ foreach mode $modes { destroy .t2 } -test fileDialog-2.7-$mode {"tk_getOpenFile: bad extension" -body { - #ToPressButton $parent cancel - set filename [tk_getOpenFile -filetypes { - {"Invalid extension" {x.y}} - {"All files" {*}} - }] - } -result {} -} + test fileDialog-2.7-$mode {"tk_getOpenFile: bad extension" -body { + #ToPressButton $parent cancel + set filename [tk_getOpenFile -filetypes { + {"Invalid extension" {x.y}} + {"All files" {*}} + }] + } -result {} + } foreach x [lsort -integer [array names filters]] { test filebox-3.$x-$mode "tk_getOpenFile command" nonUnixUserInteraction { @@ -285,7 +291,6 @@ test fileDialog-2.7-$mode {"tk_getOpenFile: bad extension" -body { catch {tk_getSaveFile -foo 1} msg regsub -all , $msg "" options regsub \"-foo\" $options "" options - foreach option $options { if {[string index $option 0] eq "-"} { test filebox-4.2-$mode$option "tk_getSaveFile command" -body { @@ -315,6 +320,9 @@ test fileDialog-2.7-$mode {"tk_getOpenFile: bad extension" -body { tk_getSaveFile -title "Press Cancel ($verylongstring)" -parent $parent } "" + # + # COMMON TEST SETUP + # set fileName "12x 455" set fileDir [pwd] set pathName [file join [pwd] $fileName] @@ -442,11 +450,10 @@ test fileDialog-2.7-$mode {"tk_getOpenFile: bad extension" -body { } # -# CLEANUP +# TESTFILE CLEANUP # set tk_strictMotif $tk_strictMotif_old removeFile filebox.tmp testutils forget dialog cleanupTests -return |