First step towards improving test style. Also start using Tcl 8.5 features.

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]
     }