diff options
Diffstat (limited to 'tk/tests/filebox.test')
-rw-r--r-- | tk/tests/filebox.test | 430 |
1 files changed, 270 insertions, 160 deletions
diff --git a/tk/tests/filebox.test b/tk/tests/filebox.test index c9112bf405a..26e4209c546 100644 --- a/tk/tests/filebox.test +++ b/tk/tests/filebox.test @@ -9,17 +9,17 @@ # RCS: @(#) $Id$ # -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} - -set tk_strictMotif_old $tk_strictMotif +package require tcltest 2.1 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands -# Some tests require user interaction on non-unix platform +namespace import -force tcltest::makeFile +namespace import -force tcltest::removeFile -set ::tcltest::testConfig(nonUnixUserInteraction) \ - [expr {$::tcltest::testConfig(userInteraction) || \ - $::tcltest::testConfig(unixOnly)}] +set tk_strictMotif_old $tk_strictMotif #---------------------------------------------------------------------- # @@ -105,185 +105,296 @@ if {$tcl_platform(platform) == "unix"} { set modes 1 } -set unknownOptionsMsg {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}} +set unknownOptionsMsg(tk_getOpenFile) {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}} +set unknownOptionsMsg(tk_getSaveFile) {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}} set tmpFile "filebox.tmp" makeFile { # this file can be empty! } $tmpFile +array set filters { + 1 {} + 2 { + {"Text files" {.txt .doc} } + {"Text files" {} TEXT} + {"Tcl Scripts" {.tcl} TEXT} + {"C Source Files" {.c .h} } + {"All Source Files" {.tcl .c .h} } + {"Image Files" {.gif} } + {"Image Files" {.jpeg .jpg} } + {"Image Files" "" {GIFF JPEG}} + {"All files" *} + } + 3 { + {"Text files" {.txt .doc} TEXT} + {"Foo" {""} TEXT} + } +} + foreach mode $modes { # # Test both the motif version and the "tk" version of the file dialog # box on Unix. # + # Note that this can use the same test number twice! + # + set addedExtensions {} if {$tcl_platform(platform) == "unix"} { set tk_strictMotif $mode - } - - # - # Test both the "open" and the "save" dialogs - # - - foreach command "tk_getOpenFile tk_getSaveFile" { - test filebox-1.1 "$command command" { - list [catch {$command -foo} msg] $msg - } $unknownOptionsMsg - - catch {$command -foo 1} msg - regsub -all , $msg "" options - regsub \"-foo\" $options "" options - - foreach option $options { - if {[string index $option 0] == "-"} { - test filebox-1.2 "$command command" { - list [catch {$command $option} msg] $msg - } [list 1 "value for \"$option\" missing"] - } + # Extension adding is only done when using the non-motif file + # box with an extension-less filename + if {!$mode} { + set addedExtensions {NONE {} .txt .txt} } + } - test filebox-1.3 "$command command" { - list [catch {$command -foo bar} msg] $msg - } $unknownOptionsMsg - - test filebox-1.4 "$command command" { - list [catch {$command -initialdir} msg] $msg - } {1 {value for "-initialdir" missing}} - - test filebox-1.5 "$command command" { - list [catch {$command -parent foo.bar} msg] $msg - } {1 {bad window path name "foo.bar"}} + test filebox-1.1 "tk_getOpenFile command" { + list [catch {tk_getOpenFile -foo} msg] $msg + } $unknownOptionsMsg(tk_getOpenFile) + + catch {tk_getOpenFile -foo 1} msg + regsub -all , $msg "" options + regsub \"-foo\" $options "" options + + foreach option $options { + if {[string index $option 0] == "-"} { + test filebox-1.2 "tk_getOpenFile command" { + list [catch {tk_getOpenFile $option} msg] $msg + } [list 1 "value for \"$option\" missing"] + } + } + + test filebox-1.3 "tk_getOpenFile command" { + list [catch {tk_getOpenFile -foo bar} msg] $msg + } $unknownOptionsMsg(tk_getOpenFile) + + test filebox-1.4 "tk_getOpenFile command" { + list [catch {tk_getOpenFile -initialdir} msg] $msg + } {1 {value for "-initialdir" missing}} + + test filebox-1.5 "tk_getOpenFile command" { + list [catch {tk_getOpenFile -parent foo.bar} msg] $msg + } {1 {bad window path name "foo.bar"}} + + test filebox-1.6 "tk_getOpenFile command" { + list [catch {tk_getOpenFile -filetypes {Foo}} msg] $msg + } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}} + + if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} { + set isNative 1 + } else { + set isNative 0 + } + + 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 + + set color #404040 + test filebox-2.1 "tk_getOpenFile command" {nonUnixUserInteraction} { + ToPressButton $parent cancel + tk_getOpenFile -title "Press Cancel ($verylongstring)" -parent $parent + } "" + + set fileName $tmpFile + set fileDir [pwd] + set pathName [file join $fileDir $fileName] + + test filebox-2.2 "tk_getOpenFile command" {nonUnixUserInteraction} { + ToPressButton $parent ok + set choice [tk_getOpenFile -title "Press Ok" \ + -parent $parent -initialfile $fileName -initialdir $fileDir] + } $pathName + + test filebox-2.3 "tk_getOpenFile command" {nonUnixUserInteraction} { + ToEnterFileByKey $parent $fileName $fileDir + set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \ + -parent $parent -initialdir $fileDir] + } $pathName + + test filebox-2.4 "tk_getOpenFile command" {nonUnixUserInteraction} { + ToPressButton $parent ok + set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \ + -parent $parent -initialdir . \ + -initialfile $fileName] + } $pathName + + test filebox-2.5 "tk_getOpenFile command" {nonUnixUserInteraction} { + ToPressButton $parent ok + set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \ + -parent $parent -initialdir /badpath \ + -initialfile $fileName] + } $pathName + + test filebox-2.6 "tk_getOpenFile command" {nonUnixUserInteraction} { + toplevel .t1; toplevel .t2 + wm geometry .t1 +0+0 + wm geometry .t2 +0+0 + ToPressButton .t1 ok + set choice {} + lappend choice [tk_getOpenFile \ + -title "Enter \"$fileName\" and press Ok" \ + -parent .t1 -initialdir $fileDir \ + -initialfile $fileName] + ToPressButton .t2 ok + lappend choice [tk_getOpenFile \ + -title "Enter \"$fileName\" and press Ok" \ + -parent .t2 -initialdir $fileDir \ + -initialfile $fileName] + ToPressButton .t1 ok + lappend choice [tk_getOpenFile \ + -title "Enter \"$fileName\" and press Ok" \ + -parent .t1 -initialdir $fileDir \ + -initialfile $fileName] + destroy .t1 + destroy .t2 + set choice + } [list $pathName $pathName $pathName] + + foreach x [lsort -integer [array names filters]] { + test filebox-3.$x "tk_getOpenFile command" {nonUnixUserInteraction} { + ToPressButton $parent ok + set choice [tk_getOpenFile -title "Press Ok" -filetypes $filters($x)\ + -parent $parent -initialfile $fileName -initialdir $fileDir] + } $pathName + } - test filebox-1.6 "$command command" { - list [catch {$command -filetypes {Foo}} msg] $msg - } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}} + test filebox-4.1 "tk_getSaveFile command" { + list [catch {tk_getSaveFile -foo} msg] $msg + } $unknownOptionsMsg(tk_getSaveFile) - if {[info commands tkMotifFDialog] == "" && [info commands ::tk::dialog::file::tkFDialog] == ""} { - set isNative 1 - } else { - set isNative 0 - } + catch {tk_getSaveFile -foo 1} msg + regsub -all , $msg "" options + regsub \"-foo\" $options "" options - 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 - - set color #404040 - test filebox-2.1 "$command command" {nonUnixUserInteraction} { - ToPressButton $parent cancel - $command -title "Press Cancel ($verylongstring)" -parent $parent - } "" - - if {$command == "tk_getSaveFile"} { - set fileName "12x 455" - set fileDir [pwd] - set pathName [file join [pwd] $fileName] - } else { - set fileName $tmpFile - set fileDir [pwd] - set pathName [file join $fileDir $fileName] + foreach option $options { + if {[string index $option 0] == "-"} { + test filebox-4.2 "tk_getSaveFile command" { + list [catch {tk_getSaveFile $option} msg] $msg + } [list 1 "value for \"$option\" missing"] } + } - test filebox-2.2 "$command command" {nonUnixUserInteraction} { - ToPressButton $parent ok - set choice [$command -title "Press Ok" \ - -parent $parent -initialfile $fileName -initialdir $fileDir] - } $pathName + test filebox-4.3 "tk_getSaveFile command" { + list [catch {tk_getSaveFile -foo bar} msg] $msg + } $unknownOptionsMsg(tk_getSaveFile) - test filebox-2.3 "$command command" {nonUnixUserInteraction} { - ToEnterFileByKey $parent $fileName $fileDir - set choice [$command -title "Enter \"$fileName\" and press Ok" \ - -parent $parent -initialdir $fileDir] - } $pathName + test filebox-4.4 "tk_getSaveFile command" { + list [catch {tk_getSaveFile -initialdir} msg] $msg + } {1 {value for "-initialdir" missing}} - test filebox-2.4 "$command command" {nonUnixUserInteraction} { - ToPressButton $parent ok - set choice [$command -title "Enter \"$fileName\" and press Ok" \ - -parent $parent -initialdir . \ - -initialfile $fileName] - } $pathName + test filebox-4.5 "tk_getSaveFile command" { + list [catch {tk_getSaveFile -parent foo.bar} msg] $msg + } {1 {bad window path name "foo.bar"}} - test filebox-2.5 "$command command" {nonUnixUserInteraction} { - ToPressButton $parent ok - set choice [$command -title "Enter \"$fileName\" and press Ok" \ - -parent $parent -initialdir /badpath \ - -initialfile $fileName] - } $pathName - - test filebox-2.6 "$command command" {nonUnixUserInteraction} { - toplevel .t1; toplevel .t2 - wm geometry .t1 +0+0 - wm geometry .t2 +0+0 - ToPressButton .t1 ok - set choice {} - lappend choice [$command \ - -title "Enter \"$fileName\" and press Ok" \ - -parent .t1 -initialdir $fileDir \ - -initialfile $fileName] - ToPressButton .t2 ok - lappend choice [$command \ - -title "Enter \"$fileName\" and press Ok" \ - -parent .t2 -initialdir $fileDir \ - -initialfile $fileName] - ToPressButton .t1 ok - lappend choice [$command \ - -title "Enter \"$fileName\" and press Ok" \ - -parent .t1 -initialdir $fileDir \ - -initialfile $fileName] - destroy .t1 - destroy .t2 - set choice - } [list $pathName $pathName $pathName] - - - - set filters(1) {} - - set filters(2) { - {"Text files" {.txt .doc} } - {"Text files" {} TEXT} - {"Tcl Scripts" {.tcl} TEXT} - {"C Source Files" {.c .h} } - {"All Source Files" {.tcl .c .h} } - {"Image Files" {.gif} } - {"Image Files" {.jpeg .jpg} } - {"Image Files" "" {GIFF JPEG}} - {"All files" *} - } + test filebox-4.6 "tk_getSaveFile command" { + list [catch {tk_getSaveFile -filetypes {Foo}} msg] $msg + } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}} - set filters(3) { - {"Text files" {.txt .doc} TEXT} - {"Foo" {""} TEXT} - } - - foreach x [lsort -integer [array names filters]] { - test filebox-3.$x "$command command" {nonUnixUserInteraction} { - ToPressButton $parent ok - set choice [$command -title "Press Ok" -filetypes $filters($x)\ - -parent $parent -initialfile $fileName -initialdir $fileDir] - } $pathName - } - - # The rest of the tests need to be executed on Unix only. - # The test whether the dialog box widgets were implemented correctly. - # These tests are not - # needed on the other platforms because they use native file dialogs. + if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} { + set isNative 1 + } else { + set isNative 0 + } - # end inner if + 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 + + set color #404040 + test filebox-5.1 "tk_getSaveFile command" {nonUnixUserInteraction} { + ToPressButton $parent cancel + tk_getSaveFile -title "Press Cancel ($verylongstring)" -parent $parent + } "" + + set fileName "12x 455" + set fileDir [pwd] + set pathName [file join [pwd] $fileName] + + test filebox-5.2 "tk_getSaveFile command" {nonUnixUserInteraction} { + ToPressButton $parent ok + set choice [tk_getSaveFile -title "Press Ok" \ + -parent $parent -initialfile $fileName -initialdir $fileDir] + } $pathName + + test filebox-5.3 "tk_getSaveFile command" {nonUnixUserInteraction} { + ToEnterFileByKey $parent $fileName $fileDir + set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \ + -parent $parent -initialdir $fileDir] + } $pathName + + test filebox-5.4 "tk_getSaveFile command" {nonUnixUserInteraction} { + ToPressButton $parent ok + set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \ + -parent $parent -initialdir . \ + -initialfile $fileName] + } $pathName + + test filebox-5.5 "tk_getSaveFile command" {nonUnixUserInteraction} { + ToPressButton $parent ok + set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \ + -parent $parent -initialdir /badpath \ + -initialfile $fileName] + } $pathName + + test filebox-5.6 "tk_getSaveFile command" {nonUnixUserInteraction} { + toplevel .t1; toplevel .t2 + wm geometry .t1 +0+0 + wm geometry .t2 +0+0 + ToPressButton .t1 ok + set choice {} + lappend choice [tk_getSaveFile \ + -title "Enter \"$fileName\" and press Ok" \ + -parent .t1 -initialdir $fileDir \ + -initialfile $fileName] + ToPressButton .t2 ok + lappend choice [tk_getSaveFile \ + -title "Enter \"$fileName\" and press Ok" \ + -parent .t2 -initialdir $fileDir \ + -initialfile $fileName] + ToPressButton .t1 ok + lappend choice [tk_getSaveFile \ + -title "Enter \"$fileName\" and press Ok" \ + -parent .t1 -initialdir $fileDir \ + -initialfile $fileName] + destroy .t1 + destroy .t2 + set choice + } [list $pathName $pathName $pathName] + + foreach x [lsort -integer [array names filters]] { + test filebox-6.$x "tk_getSaveFile command" {nonUnixUserInteraction} { + ToPressButton $parent ok + set choice [tk_getSaveFile -title "Press Ok" -filetypes $filters($x)\ + -parent $parent -initialfile $fileName -initialdir $fileDir] + } $pathName[lindex $addedExtensions $x] } - # end outer if + # The rest of the tests need to be executed on Unix only. + # The test whether the dialog box widgets were implemented correctly. + # These tests are not + # needed on the other platforms because they use native file dialogs. } set tk_strictMotif $tk_strictMotif_old @@ -291,4 +402,3 @@ set tk_strictMotif $tk_strictMotif_old # cleanup ::tcltest::cleanupTests return - |