diff options
Diffstat (limited to 'tests/filebox.test')
| -rw-r--r-- | tests/filebox.test | 410 |
1 files changed, 260 insertions, 150 deletions
diff --git a/tests/filebox.test b/tests/filebox.test index e288b39..c4485bf 100644 --- a/tests/filebox.test +++ b/tests/filebox.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: filebox.test,v 1.11 2001/08/01 16:21:12 dgp Exp $ +# RCS: @(#) $Id: filebox.test,v 1.12 2002/02/25 15:26:20 dkf Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -113,178 +113,288 @@ 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($command) - - 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($command) - - 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 tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} { - 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 |