summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2002-02-25 15:26:20 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2002-02-25 15:26:20 (GMT)
commit8524a21e97d49a594aff3d8534448099e338f18c (patch)
tree2d8693b8b128a4402fc3d3700113cb6b5a161ff5
parent14e2ba000eb5689e015f077d557e938282446e03 (diff)
downloadtk-8524a21e97d49a594aff3d8534448099e338f18c.zip
tk-8524a21e97d49a594aff3d8534448099e338f18c.tar.gz
tk-8524a21e97d49a594aff3d8534448099e338f18c.tar.bz2
Improvements to filebox tests (including two fixes due to changed behaviour dating from 2001-12-14)
-rw-r--r--ChangeLog6
-rw-r--r--tests/filebox.test410
2 files changed, 266 insertions, 150 deletions
diff --git a/ChangeLog b/ChangeLog
index 7eac77a..ecb067f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2002-02-25 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * tests/filebox.test: Reorganised and fixed so that tests are
+ executed fewer times (!) and the automatic extension adding
+ behaviour of tk_getSaveFile is tested.
+
2002-02-23 Mo DeJong <mdejong@users.sourceforge.net>
* unix/configure: Regen.
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