diff options
Diffstat (limited to 'tests/filebox.test')
| -rw-r--r-- | tests/filebox.test | 227 |
1 files changed, 104 insertions, 123 deletions
diff --git a/tests/filebox.test b/tests/filebox.test index e386022..e7e386f 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.14 2003/04/01 21:06:23 dgp Exp $ +# RCS: @(#) $Id: filebox.test,v 1.15 2004/05/23 17:34:48 dkf Exp $ # package require tcltest 2.1 @@ -99,8 +99,8 @@ if {$tcl_platform(platform) == "unix"} { set modes 1 } -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 unknownOptionsMsg(tk_getOpenFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title} +set unknownOptionsMsg(tk_getSaveFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title} set tmpFile "filebox.tmp" makeFile { @@ -127,12 +127,11 @@ array set filters { } 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! + # Note that this means that test names are unusually complex. # set addedExtensions {} @@ -145,46 +144,42 @@ foreach mode $modes { } } - test filebox-1.1 "tk_getOpenFile command" { - list [catch {tk_getOpenFile -foo} msg] $msg - } $unknownOptionsMsg(tk_getOpenFile) + test filebox-1.1-$mode "tk_getOpenFile command" -body { + tk_getOpenFile -foo + } -returnCodes error -result $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"] + if {[string index $option 0] eq "-"} { + test filebox-1.2-$mode$option "tk_getOpenFile command" -body { + tk_getOpenFile $option + } -returnCode error -result "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 - } - + + test filebox-1.3-$mode "tk_getOpenFile command" -body { + tk_getOpenFile -foo bar + } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile) + test filebox-1.4-$mode "tk_getOpenFile command" -body { + tk_getOpenFile -initialdir + } -returnCodes error -result {value for "-initialdir" missing} + test filebox-1.5-$mode "tk_getOpenFile command" -body { + tk_getOpenFile -parent foo.bar + } -returnCodes error -result {bad window path name "foo.bar"} + test filebox-1.6-$mode "tk_getOpenFile command" -body { + tk_getOpenFile -filetypes {Foo} + } -returnCodes error -result {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"} + + set isNative [expr { + [info commands ::tk::MotifFDialog] eq "" && + [info commands ::tk::dialog::file::] eq "" + }] + set parent . - + set verylongstring longstring: set verylongstring $verylongstring$verylongstring set verylongstring $verylongstring$verylongstring @@ -197,111 +192,103 @@ foreach mode $modes { # set verylongstring $verylongstring$verylongstring set color #404040 - test filebox-2.1 "tk_getOpenFile command" {nonUnixUserInteraction} { + test filebox-2.1-$mode "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} { + + test filebox-2.2-$mode "tk_getOpenFile command" nonUnixUserInteraction { ToPressButton $parent ok set choice [tk_getOpenFile -title "Press Ok" \ - -parent $parent -initialfile $fileName -initialdir $fileDir] + -parent $parent -initialfile $fileName -initialdir $fileDir] } $pathName - - test filebox-2.3 "tk_getOpenFile command" {nonUnixUserInteraction} { + test filebox-2.3-$mode "tk_getOpenFile command" nonUnixUserInteraction { ToEnterFileByKey $parent $fileName $fileDir set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \ - -parent $parent -initialdir $fileDir] + -parent $parent -initialdir $fileDir] } $pathName - - test filebox-2.4 "tk_getOpenFile command" {nonUnixUserInteraction} { + test filebox-2.4-$mode "tk_getOpenFile command" nonUnixUserInteraction { ToPressButton $parent ok set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \ - -parent $parent -initialdir . \ - -initialfile $fileName] + -parent $parent -initialdir . -initialfile $fileName] } $pathName - - test filebox-2.5 "tk_getOpenFile command" {nonUnixUserInteraction} { + test filebox-2.5-$mode "tk_getOpenFile command" nonUnixUserInteraction { ToPressButton $parent ok set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \ - -parent $parent -initialdir /badpath \ - -initialfile $fileName] + -parent $parent -initialdir /badpath -initialfile $fileName] } $pathName - - test filebox-2.6 "tk_getOpenFile command" {nonUnixUserInteraction} { + test filebox-2.6-$mode "tk_getOpenFile command" -setup { toplevel .t1; toplevel .t2 wm geometry .t1 +0+0 wm geometry .t2 +0+0 - ToPressButton .t1 ok + } -constraints nonUnixUserInteraction -body { set choice {} + ToPressButton .t1 ok lappend choice [tk_getOpenFile \ - -title "Enter \"$fileName\" and press Ok" \ - -parent .t1 -initialdir $fileDir \ - -initialfile $fileName] + -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] + -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] + -title "Enter \"$fileName\" and press Ok" \ + -parent .t1 -initialdir $fileDir \ + -initialfile $fileName] + } -result [list $pathName $pathName $pathName] -cleanup { 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] + test filebox-3.$x-$mode "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-4.1 "tk_getSaveFile command" { - list [catch {tk_getSaveFile -foo} msg] $msg - } $unknownOptionsMsg(tk_getSaveFile) + test filebox-4.1-$mode "tk_getSaveFile command" -body { + tk_getSaveFile -foo + } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile) catch {tk_getSaveFile -foo 1} msg regsub -all , $msg "" options regsub \"-foo\" $options "" options 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"] + if {[string index $option 0] eq "-"} { + test filebox-4.2-$mode$option "tk_getSaveFile command" -body { + tk_getSaveFile $option + } -returnCodes error -result "value for \"$option\" missing" } } - test filebox-4.3 "tk_getSaveFile command" { - list [catch {tk_getSaveFile -foo bar} msg] $msg - } $unknownOptionsMsg(tk_getSaveFile) - - test filebox-4.4 "tk_getSaveFile command" { - list [catch {tk_getSaveFile -initialdir} msg] $msg - } {1 {value for "-initialdir" missing}} - - 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-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 ...?}?"}} - - if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} { - set isNative 1 - } else { - set isNative 0 - } + test filebox-4.3-$mode "tk_getSaveFile command" -body { + tk_getSaveFile -foo bar + } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile) + test filebox-4.4-$mode "tk_getSaveFile command" -body { + tk_getSaveFile -initialdir + } -returnCodes error -result {value for "-initialdir" missing} + test filebox-4.5-$mode "tk_getSaveFile command" -body { + tk_getSaveFile -parent foo.bar + } -returnCodes error -result {bad window path name "foo.bar"} + test filebox-4.6-$mode "tk_getSaveFile command" -body { + tk_getSaveFile -filetypes {Foo} + } -returnCodes error -result {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"} + + set isNative [expr { + [info commands ::tk::MotifFDialog] eq "" && + [info commands ::tk::dialog::file::] eq "" + }] set parent . @@ -317,7 +304,7 @@ foreach mode $modes { # set verylongstring $verylongstring$verylongstring set color #404040 - test filebox-5.1 "tk_getSaveFile command" {nonUnixUserInteraction} { + test filebox-5.1-$mode "tk_getSaveFile command" nonUnixUserInteraction { ToPressButton $parent cancel tk_getSaveFile -title "Press Cancel ($verylongstring)" -parent $parent } "" @@ -326,62 +313,56 @@ foreach mode $modes { set fileDir [pwd] set pathName [file join [pwd] $fileName] - test filebox-5.2 "tk_getSaveFile command" {nonUnixUserInteraction} { + test filebox-5.2-$mode "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} { + test filebox-5.3-$mode "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} { + test filebox-5.4-$mode "tk_getSaveFile command" nonUnixUserInteraction { ToPressButton $parent ok set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \ - -parent $parent -initialdir . \ - -initialfile $fileName] + -parent $parent -initialdir . -initialfile $fileName] } $pathName - - test filebox-5.5 "tk_getSaveFile command" {nonUnixUserInteraction} { + test filebox-5.5-$mode "tk_getSaveFile command" nonUnixUserInteraction { ToPressButton $parent ok set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \ - -parent $parent -initialdir /badpath \ - -initialfile $fileName] + -parent $parent -initialdir /badpath -initialfile $fileName] } $pathName - test filebox-5.6 "tk_getSaveFile command" {nonUnixUserInteraction} { + test filebox-5.6-$mode "tk_getSaveFile command" -setup { toplevel .t1; toplevel .t2 wm geometry .t1 +0+0 wm geometry .t2 +0+0 - ToPressButton .t1 ok + } -constraints nonUnixUserInteraction -body { set choice {} + ToPressButton .t1 ok lappend choice [tk_getSaveFile \ -title "Enter \"$fileName\" and press Ok" \ - -parent .t1 -initialdir $fileDir \ - -initialfile $fileName] + -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] + -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] + -parent .t1 -initialdir $fileDir -initialfile $fileName] + } -result [list $pathName $pathName $pathName] -cleanup { 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} { + test filebox-6.$x-$mode "tk_getSaveFile command" nonUnixUserInteraction { ToPressButton $parent ok - set choice [tk_getSaveFile -title "Press Ok" -filetypes $filters($x)\ - -parent $parent -initialfile $fileName -initialdir $fileDir] + set choice [tk_getSaveFile -title "Press Ok" \ + -filetypes $filters($x) -parent $parent \ + -initialfile $fileName -initialdir $fileDir] } $pathName[lindex $addedExtensions $x] } |