Improvements to filebox tests (including two fixes due to changed behaviour dating from 2001-12-14)

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