Update to tcltest2

1 files changed, 349 insertions, 156 deletions

diff --git a/tests/option.test b/tests/option.test
index 2cdd675..2cf574e 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -6,16 +6,16 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: option.test,v 1.6 2004/05/23 17:34:49 dkf Exp $
+# RCS: @(#) $Id: option.test,v 1.7 2008/08/28 08:52:05 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
 testConstraint appNameIsTktest [expr {[winfo name .] eq "tktest"}]
 
-catch {destroy .op1}
-catch {destroy .op2}
+deleteWindows
 set appName [winfo name .]
 
 # First, test basic retrievals, being sure to trigger all the various
@@ -29,6 +29,7 @@ frame .op1.op4 -class Class3
 frame .op2.op5 -class Class2
 frame .op1.op3.op6 -class Class4
 
+# Configurations for tests 1.* - 12.*
 option clear
 option add *Color1 red
 option add *x blue
@@ -40,97 +41,254 @@ option add $appName.Class1.Class3.y brown
 option add $appName*op6*Color2 black
 option add $appName*Class1.op1.Color2 grey
 
-test option-1.1 {basic option retrieval} {option get . x Color1} blue
-test option-1.2 {basic option retrieval} {option get . y Color1} red
-test option-1.3 {basic option retrieval} {option get . z Color1} red
-test option-1.4 {basic option retrieval} {option get . x Color2} blue
-test option-1.5 {basic option retrieval} {option get . y Color2} {}
-test option-1.6 {basic option retrieval} {option get . z Color2} {}
-
-test option-2.1 {basic option retrieval} {option get .op1 x Color1} green
-test option-2.2 {basic option retrieval} {option get .op1 y Color1} red
-test option-2.3 {basic option retrieval} {option get .op1 z Color1} red
-test option-2.4 {basic option retrieval} {option get .op1 x Color2} green
-test option-2.5 {basic option retrieval} {option get .op1 y Color2} {}
-test option-2.6 {basic option retrieval} {option get .op1 z Color2} {}
-
-test option-3.1 {basic option retrieval} {option get .op1.op3 x Color1} yellow
-test option-3.2 {basic option retrieval} {option get .op1.op3 y Color1} red
-test option-3.3 {basic option retrieval} {option get .op1.op3 z Color1} red
-test option-3.4 {basic option retrieval} {option get .op1.op3 x Color2} yellow
-test option-3.5 {basic option retrieval} {option get .op1.op3 y Color2} {}
-test option-3.6 {basic option retrieval} {option get .op1.op3 z Color2} {}
-
-test option-4.1 {basic option retrieval} {option get .op1.op3.op6 x Color1} blue
-test option-4.2 {basic option retrieval} {option get .op1.op3.op6 y Color1} red
-test option-4.3 {basic option retrieval} {option get .op1.op3.op6 z Color1} red
-test option-4.4 {basic option retrieval} {option get .op1.op3.op6 x Color2} black
-test option-4.5 {basic option retrieval} {option get .op1.op3.op6 y Color2} black
-test option-4.6 {basic option retrieval} {option get .op1.op3.op6 z Color2} black
-
-test option-5.1 {basic option retrieval} {option get .op1.op4 x Color1} blue
-test option-5.2 {basic option retrieval} {option get .op1.op4 y Color1} brown
-test option-5.3 {basic option retrieval} {option get .op1.op4 z Color1} red
-test option-5.4 {basic option retrieval} {option get .op1.op4 x Color2} blue
-test option-5.5 {basic option retrieval} {option get .op1.op4 y Color2} brown
-test option-5.6 {basic option retrieval} {option get .op1.op4 z Color2} {}
-
-test option-6.1 {basic option retrieval} {option get .op2 x Color1} orange
-test option-6.2 {basic option retrieval} {option get .op2 y Color1} orange
-test option-6.3 {basic option retrieval} {option get .op2 z Color1} orange
-test option-6.4 {basic option retrieval} {option get .op2 x Color2} blue
-test option-6.5 {basic option retrieval} {option get .op2 y Color2} {}
-test option-6.6 {basic option retrieval} {option get .op2 z Color2} {}
-
-test option-7.1 {basic option retrieval} {option get .op2.op5 x Color1} orange
-test option-7.2 {basic option retrieval} {option get .op2.op5 y Color1} orange
-test option-7.3 {basic option retrieval} {option get .op2.op5 z Color1} orange
-test option-7.4 {basic option retrieval} {option get .op2.op5 x Color2} purple
-test option-7.5 {basic option retrieval} {option get .op2.op5 y Color2} purple
-test option-7.6 {basic option retrieval} {option get .op2.op5 z Color2} purple
+test option-1.1 {basic option retrieval} -body {
+    option get . x Color1
+} -result blue
+test option-1.2 {basic option retrieval} -body {
+    option get . y Color1
+} -result red
+test option-1.3 {basic option retrieval} -body {
+    option get . z Color1
+} -result red
+test option-1.4 {basic option retrieval} -body {
+    option get . x Color2
+} -result blue
+test option-1.5 {basic option retrieval} -body {
+    option get . y Color2
+} -result {}
+test option-1.6 {basic option retrieval} -body {
+    option get . z Color2
+} -result {}
+
+
+test option-2.1 {basic option retrieval} -body {
+    option get .op1 x Color1
+} -result green
+test option-2.2 {basic option retrieval} -body {
+    option get .op1 y Color1
+} -result red
+test option-2.3 {basic option retrieval} -body {
+    option get .op1 z Color1
+} -result red
+test option-2.4 {basic option retrieval} -body {
+    option get .op1 x Color2
+} -result green
+test option-2.5 {basic option retrieval} -body {
+    option get .op1 y Color2
+} -result {}
+test option-2.6 {basic option retrieval} -body {
+    option get .op1 z Color2
+} -result {}
+
+
+test option-3.1 {basic option retrieval} -body {
+    option get .op1.op3 x Color1
+} -result yellow
+test option-3.2 {basic option retrieval} -body {
+    option get .op1.op3 y Color1
+} -result red
+test option-3.3 {basic option retrieval} -body {
+    option get .op1.op3 z Color1
+} -result red
+test option-3.4 {basic option retrieval} -body {
+    option get .op1.op3 x Color2
+} -result yellow
+test option-3.5 {basic option retrieval} -body {
+    option get .op1.op3 y Color2
+} -result {}
+test option-3.6 {basic option retrieval} -body {
+    option get .op1.op3 z Color2
+} -result {}
+
+
+test option-4.1 {basic option retrieval} -body {
+    option get .op1.op3.op6 x Color1
+} -result blue
+test option-4.2 {basic option retrieval} -body {
+    option get .op1.op3.op6 y Color1
+} -result red
+test option-4.3 {basic option retrieval} -body {
+    option get .op1.op3.op6 z Color1
+} -result red
+test option-4.4 {basic option retrieval} -body {
+    option get .op1.op3.op6 x Color2
+} -result black
+test option-4.5 {basic option retrieval} -body {
+    option get .op1.op3.op6 y Color2
+} -result black
+test option-4.6 {basic option retrieval} -body {
+    option get .op1.op3.op6 z Color2
+} -result black
+
+
+test option-5.1 {basic option retrieval} -body {
+    option get .op1.op4 x Color1
+} -result blue
+test option-5.2 {basic option retrieval} -body {
+    option get .op1.op4 y Color1
+} -result brown
+test option-5.3 {basic option retrieval} -body {
+    option get .op1.op4 z Color1
+} -result red
+test option-5.4 {basic option retrieval} -body {
+    option get .op1.op4 x Color2
+} -result blue
+test option-5.5 {basic option retrieval} -body {
+    option get .op1.op4 y Color2
+} -result brown
+test option-5.6 {basic option retrieval} -body {
+    option get .op1.op4 z Color2
+} -result {}
+
+
+test option-6.1 {basic option retrieval} -body {
+    option get .op2 x Color1
+} -result orange
+test option-6.2 {basic option retrieval} -body {
+    option get .op2 y Color1
+} -result orange
+test option-6.3 {basic option retrieval} -body {
+    option get .op2 z Color1
+} -result orange
+test option-6.4 {basic option retrieval} -body {
+    option get .op2 x Color2
+} -result blue
+test option-6.5 {basic option retrieval} -body {
+    option get .op2 y Color2
+} -result {}
+test option-6.6 {basic option retrieval} -body {
+    option get .op2 z Color2
+} -result {}
+
+
+test option-7.1 {basic option retrieval} -body {
+    option get .op2.op5 x Color1
+} -result orange
+test option-7.2 {basic option retrieval} -body {
+    option get .op2.op5 y Color1
+} -result orange
+test option-7.3 {basic option retrieval} -body {
+    option get .op2.op5 z Color1
+} -result orange
+test option-7.4 {basic option retrieval} -body {
+    option get .op2.op5 x Color2
+} -result purple
+test option-7.5 {basic option retrieval} -body {
+    option get .op2.op5 y Color2
+} -result purple
+test option-7.6 {basic option retrieval} -body {
+    option get .op2.op5 z Color2
+} -result purple
+
 
 # Now try similar tests to above, except jump around non-hierarchically
 # between windows to make sure that the option stacks are pushed and
 # popped correctly.
 
 option get . foo Foo
-test option-8.1 {stack pushing/popping} {option get .op2.op5 x Color1} orange
-test option-8.2 {stack pushing/popping} {option get .op2.op5 y Color1} orange
-test option-8.3 {stack pushing/popping} {option get .op2.op5 z Color1} orange
-test option-8.4 {stack pushing/popping} {option get .op2.op5 x Color2} purple
-test option-8.5 {stack pushing/popping} {option get .op2.op5 y Color2} purple
-test option-8.6 {stack pushing/popping} {option get .op2.op5 z Color2} purple
-
-test option-9.1 {stack pushing/popping} {option get . x Color1} blue
-test option-9.2 {stack pushing/popping} {option get . y Color1} red
-test option-9.3 {stack pushing/popping} {option get . z Color1} red
-test option-9.4 {stack pushing/popping} {option get . x Color2} blue
-test option-9.5 {stack pushing/popping} {option get . y Color2} {}
-test option-9.6 {stack pushing/popping} {option get . z Color2} {}
-
-test option-10.1 {stack pushing/popping} {option get .op1.op3.op6 x Color1} blue
-test option-10.2 {stack pushing/popping} {option get .op1.op3.op6 y Color1} red
-test option-10.3 {stack pushing/popping} {option get .op1.op3.op6 z Color1} red
-test option-10.4 {stack pushing/popping} {option get .op1.op3.op6 x Color2} black
-test option-10.5 {stack pushing/popping} {option get .op1.op3.op6 y Color2} black
-test option-10.6 {stack pushing/popping} {option get .op1.op3.op6 z Color2} black
-
-test option-11.1 {stack pushing/popping} {option get .op1.op3 x Color1} yellow
-test option-11.2 {stack pushing/popping} {option get .op1.op3 y Color1} red
-test option-11.3 {stack pushing/popping} {option get .op1.op3 z Color1} red
-test option-11.4 {stack pushing/popping} {option get .op1.op3 x Color2} yellow
-test option-11.5 {stack pushing/popping} {option get .op1.op3 y Color2} {}
-test option-11.6 {stack pushing/popping} {option get .op1.op3 z Color2} {}
-
-test option-12.1 {stack pushing/popping} {option get .op1 x Color1} green
-test option-12.2 {stack pushing/popping} {option get .op1 y Color1} red
-test option-12.3 {stack pushing/popping} {option get .op1 z Color1} red
-test option-12.4 {stack pushing/popping} {option get .op1 x Color2} green
-test option-12.5 {stack pushing/popping} {option get .op1 y Color2} {}
-test option-12.6 {stack pushing/popping} {option get .op1 z Color2} {}
+test option-8.1 {stack pushing/popping} -body {
+    option get .op2.op5 x Color1
+} -result orange
+test option-8.2 {stack pushing/popping} -body {
+    option get .op2.op5 y Color1
+} -result orange
+test option-8.3 {stack pushing/popping} -body {
+    option get .op2.op5 z Color1
+} -result orange
+test option-8.4 {stack pushing/popping} -body {
+    option get .op2.op5 x Color2
+} -result purple
+test option-8.5 {stack pushing/popping} -body {
+    option get .op2.op5 y Color2
+} -result purple
+test option-8.6 {stack pushing/popping} -body {
+    option get .op2.op5 z Color2
+} -result purple
+
+
+test option-9.1 {stack pushing/popping} -body {
+    option get . x Color1
+} -result blue
+test option-9.2 {stack pushing/popping} -body {
+    option get . y Color1
+} -result red
+test option-9.3 {stack pushing/popping} -body {
+    option get . z Color1
+} -result red
+test option-9.4 {stack pushing/popping} -body {
+    option get . x Color2
+} -result blue
+test option-9.5 {stack pushing/popping} -body {
+    option get . y Color2
+} -result {}
+test option-9.6 {stack pushing/popping} -body {
+    option get . z Color2
+} -result {}
+
+
+test option-10.1 {stack pushing/popping} -body {
+    option get .op1.op3.op6 x Color1
+} -result blue
+test option-10.2 {stack pushing/popping} -body {
+    option get .op1.op3.op6 y Color1
+} -result red
+test option-10.3 {stack pushing/popping} -body {
+    option get .op1.op3.op6 z Color1
+} -result red
+test option-10.4 {stack pushing/popping} -body {
+    option get .op1.op3.op6 x Color2
+} -result black
+test option-10.5 {stack pushing/popping} -body {
+    option get .op1.op3.op6 y Color2
+} -result black
+test option-10.6 {stack pushing/popping} -body {
+    option get .op1.op3.op6 z Color2
+} -result black
+
+
+test option-11.1 {stack pushing/popping} -body {
+    option get .op1.op3 x Color1
+} -result yellow
+test option-11.2 {stack pushing/popping} -body {
+    option get .op1.op3 y Color1
+} -result red
+test option-11.3 {stack pushing/popping} -body {
+    option get .op1.op3 z Color1
+} -result red
+test option-11.4 {stack pushing/popping} -body {
+    option get .op1.op3 x Color2
+} -result yellow
+test option-11.5 {stack pushing/popping} -body {
+    option get .op1.op3 y Color2
+} -result {}
+test option-11.6 {stack pushing/popping} -body {
+    option get .op1.op3 z Color2
+} -result {}
+
+
+test option-12.1 {stack pushing/popping} -body {
+    option get .op1 x Color1
+} -result green
+test option-12.2 {stack pushing/popping} -body {
+    option get .op1 y Color1
+} -result red
+test option-12.3 {stack pushing/popping} -body {
+    option get .op1 z Color1
+} -result red
+test option-12.4 {stack pushing/popping} -body {
+    option get .op1 x Color2
+} -result green
+test option-12.5 {stack pushing/popping} -body {
+    option get .op1 y Color2
+} -result {}
+test option-12.6 {stack pushing/popping} -body {
+    option get .op1 z Color2
+} -result {}
 
 # Test the major priority levels (widgetDefault, etc.)
 
+# Configurations for tests 13.* 
+option clear
 option add $appName.op1.a 100 100
 option add $appName.op1.A interactive interactive
 option add $appName.op1.b userDefault userDefault
@@ -138,92 +296,127 @@ option add $appName.op1.B startupFile startupFile
 option add $appName.op1.c widgetDefault widgetDefault
 option add $appName.op1.C 0 0
 
-test option-13.1 {priority levels} {option get .op1 a A} 100
-test option-13.2 {priority levels} {option get .op1 b A} interactive
-test option-13.3 {priority levels} {option get .op1 b B} userDefault
-test option-13.4 {priority levels} {option get .op1 c B} startupFile
-test option-13.5 {priority levels} {option get .op1 c C} widgetDefault
+test option-13.1 {priority levels} -body {
+    option get .op1 a A
+} -result 100
+test option-13.2 {priority levels} -body {
+    option get .op1 b A
+} -result interactive
+test option-13.3 {priority levels} -body {
+    option get .op1 b B
+} -result userDefault
+test option-13.4 {priority levels} -body {
+    option get .op1 c B
+} -result startupFile
+test option-13.5 {priority levels} -body {
+    option get .op1 c C
+} -result widgetDefault
 option add $appName.op1.B file2 widget
-test option-13.6 {priority levels} {option get .op1 c B} startupFile
+test option-13.6 {priority levels} -body {
+    option get .op1 c B
+} -result startupFile
 option add $appName.op1.B file2 startupFile
-test option-13.7 {priority levels} {option get .op1 c B} file2
+test option-13.7 {priority levels} -body {
+    option get .op1 c B
+} -result file2
+
 
 # Test various error conditions
 
-test option-14.1 {error conditions} {
-    list [catch {option} msg] $msg
-} {1 {wrong # args: should be "option cmd arg ?arg ...?"}}
-test option-14.2 {error conditions} {
-    list [catch {option x} msg] $msg
-} {1 {bad option "x": must be add, clear, get, or readfile}}
-test option-14.3 {error conditions} {
-    list [catch {option foo 3} msg] $msg
-} {1 {bad option "foo": must be add, clear, get, or readfile}}
-test option-14.4 {error conditions} {
-    list [catch {option add 3} msg] $msg
-} {1 {wrong # args: should be "option add pattern value ?priority?"}}
-test option-14.5 {error conditions} {
-    list [catch {option add . a b c} msg] $msg
-} {1 {wrong # args: should be "option add pattern value ?priority?"}}
-test option-14.6 {error conditions} {
-    list [catch {option add . a -1} msg] $msg
-} {1 {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
-test option-14.7 {error conditions} {
-    list [catch {option add . a 101} msg] $msg
-} {1 {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
-test option-14.8 {error conditions} {
-    list [catch {option add . a gorp} msg] $msg
-} {1 {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
-test option-14.9 {error conditions} {
-    list [catch {option get 3} msg] $msg
-} {1 {wrong # args: should be "option get window name class"}}
-test option-14.10 {error conditions} {
-    list [catch {option get 3 4} msg] $msg
-} {1 {wrong # args: should be "option get window name class"}}
-test option-14.11 {error conditions} {
-    list [catch {option get 3 4 5 6} msg] $msg
-} {1 {wrong # args: should be "option get window name class"}}
-test option-14.12 {error conditions} {
-    list [catch {option get .gorp.gorp a A} msg] $msg
-} {1 {bad window path name ".gorp.gorp"}}
+test option-14.1 {error conditions} -body {
+    option
+} -returnCodes error -result {wrong # args: should be "option cmd arg ?arg ...?"}
+test option-14.2 {error conditions} -body {
+    option x
+} -returnCodes error -result {bad option "x": must be add, clear, get, or readfile}
+test option-14.3 {error conditions} -body {
+    option foo 3
+} -returnCodes error -result {bad option "foo": must be add, clear, get, or readfile}
+test option-14.4 {error conditions} -body {
+    option add 3
+} -returnCodes error -result {wrong # args: should be "option add pattern value ?priority?"}
+test option-14.5 {error conditions} -body {
+    option add . a b c
+} -returnCodes error -result {wrong # args: should be "option add pattern value ?priority?"}
+test option-14.6 {error conditions} -body {
+    option add . a -1
+} -returnCodes error -result {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}
+test option-14.7 {error conditions} -body {
+    option add . a 101
+} -returnCodes error -result {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}
+test option-14.8 {error conditions} -body {
+    option add . a gorp
+} -returnCodes error -result {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}
+test option-14.9 {error conditions} -body {
+    option get 3
+} -returnCodes error -result {wrong # args: should be "option get window name class"}
+test option-14.10 {error conditions} -body {
+    option get 3 4
+} -returnCodes error -result {wrong # args: should be "option get window name class"}
+test option-14.11 {error conditions} -body {
+    option get 3 4 5 6
+} -returnCodes error -result {wrong # args: should be "option get window name class"}
+test option-14.12 {error conditions} -body {
+    option get .gorp.gorp a A
+} -returnCodes error -result {bad window path name ".gorp.gorp"}
+
 
 set option1 [file join [testsDirectory] option.file1]
-set option2 [file join [testsDirectory] option.file2]
-
-test option-15.1 {database files} {
-    list [catch {option read non-existent} msg] $msg
-} {1 {couldn't open "non-existent": no such file or directory}}
-option read $option1
-test option-15.2 {database files} {option get . x1 color} blue
-test option-15.3 {database files} appNameIsTktest {option get . x2 color} green
-test option-15.4 {database files} {option get . x3 color} purple
-test option-15.5 {database files} {option get . {x 4} color} brown
-test option-15.6 {database files} {option get . x6 color} {}
-test option-15.7 {database files} {
-    list [catch {option read $option1 widget foo} msg] $msg
-} {1 {wrong # args: should be "option readfile fileName ?priority?"}}
-option add *x3 burgundy
-catch {option read $option1 userDefault}
-test option-15.8 {database files} {option get . x3 color} burgundy
-test option-15.9 {database files} {
-    list [catch {option read $option2} msg] $msg
-} {1 {missing colon on line 2}}
-
-test option-16.1 {ReadOptionFile} {
+test option-15.1 {database files} -body {
+    option read non-existent
+} -returnCodes error -result {couldn't open "non-existent": no such file or directory}
+test option-15.2 {database files} -body {
+    option read $option1
+    option get . x1 color
+} -result blue
+test option-15.3 {database files} -constraints appNameIsTktest -body {
+    option read $option1
+    option get . x2 color
+} -result green
+test option-15.4 {database files} -body {
+    option read $option1
+    option get . x3 color
+} -result purple
+test option-15.5 {database files} -body {
+    option read $option1
+    option get . {x 4} color
+} -result brown
+test option-15.6 {database files} -body {
+    option read $option1
+	option get . x6 color
+} -result {}
+test option-15.7 {database files} -body {
+    option read $option1 widget foo
+} -returnCodes error -result {wrong # args: should be "option readfile fileName ?priority?"}
+
+test option-15.8 {database files} -body {
+    option add *x3 burgundy
+    catch {option read $option1 userDefault}
+    option get . x3 color
+} -result burgundy
+test option-15.9 {database files} -body {
+    set option2 [file join [testsDirectory] option.file2]
+    option read $option2
+} -returnCodes error -result {missing colon on line 2}
+
+
+test option-16.1 {ReadOptionFile} -body {
     set option3 [makeFile {} option.file3]
     set file [open $option3 w]
     fconfigure $file -translation crlf
     puts $file "*x7: true\n*x8: false"
     close $file
     option read $option3 userDefault
-    set result [list [option get . x7 color] [option get . x8 color]]
+    list [option get . x7 color] [option get . x8 color]
+} -cleanup {
     removeFile $option3
-    set result
-} {true false}
+} -result {true false}
 
-catch {destroy .op1}
-catch {destroy .op2}
+deleteWindows
 
 # cleanup
 cleanupTests
 return
+
+
+