From 7c820a9ae19502e7f5d59f4310c33bfeb64bf9ba Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 23 May 2004 17:34:48 +0000
Subject: First step towards improving test style.  Also start using Tcl 8.5
 features.

---
 ChangeLog              |   3 +
 tests/bell.test        |  15 +-
 tests/bgerror.test     |  15 +-
 tests/bind.test        | 577 +++++++++++++++++++++++++------------------------
 tests/bitmap.test      |  15 +-
 tests/border.test      |  15 +-
 tests/button.test      |  52 +++--
 tests/canvImg.test     |  62 ++----
 tests/canvPs.test      |  15 +-
 tests/canvRect.test    |  46 ++--
 tests/canvText.test    |  31 +--
 tests/canvWind.test    |  15 +-
 tests/canvas.test      |  45 ++--
 tests/choosedir.test   |   4 +-
 tests/clipboard.test   |  15 +-
 tests/clrpick.test     |  16 +-
 tests/cmds.test        |  15 +-
 tests/cursor.test      | 228 ++++++++++---------
 tests/entry.test       |  16 +-
 tests/filebox.test     | 227 +++++++++----------
 tests/focus.test       |  15 +-
 tests/focusTcl.test    |  15 +-
 tests/font.test        | 155 ++++++-------
 tests/frame.test       | 349 ++++++++++++++++--------------
 tests/geometry.test    |  15 +-
 tests/get.test         |  15 +-
 tests/id.test          |  15 +-
 tests/imgBmap.test     |  15 +-
 tests/imgPPM.test      |  15 +-
 tests/imgPhoto.test    |   4 +-
 tests/main.test        |  15 +-
 tests/menu.test        |  16 +-
 tests/menuDraw.test    |  15 +-
 tests/menubut.test     |  15 +-
 tests/msgbox.test      |  34 ++-
 tests/obj.test         |  16 +-
 tests/oldpack.test     |  15 +-
 tests/option.test      |  21 +-
 tests/panedwindow.test |   6 +-
 tests/raise.test       |  15 +-
 tests/scale.test       |   4 +-
 tests/scrollbar.test   |  17 +-
 tests/select.test      |  64 ++----
 tests/textBTree.test   |  15 +-
 tests/textDisp.test    |  14 +-
 tests/textImage.test   |  15 +-
 tests/textIndex.test   |  15 +-
 tests/textMark.test    |  15 +-
 tests/textTag.test     |  15 +-
 tests/textWind.test    |  27 +--
 tests/unixEmbed.test   |  15 +-
 tests/unixFont.test    |  15 +-
 tests/util.test        |  15 +-
 tests/visual.test      | 258 +++++++++++-----------
 tests/winMenu.test     |  14 +-
 tests/winSend.test     |  48 ++--
 tests/window.test      |  14 +-
 tests/wm.test          |   5 +-
 tests/xmfbox.test      |  14 +-
 59 files changed, 1150 insertions(+), 1657 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ebeefb2..08693fd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2004-05-23  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	* tests/*.test: Many minor fixes aiming towards making the Tk test
+	suite have better style.
+
 	* generic/tkVisual.c (Tk_GetVisual): Minor fix for error message.
 
 2004-05-14  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
diff --git a/tests/bell.test b/tests/bell.test
index 59bfca6..455eb76 100644
--- a/tests/bell.test
+++ b/tests/bell.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-2000 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: bell.test,v 1.7 2003/04/01 21:06:15 dgp Exp $
+# RCS: @(#) $Id: bell.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -46,16 +46,3 @@ test bell-1.8 {bell command} {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/bgerror.test b/tests/bgerror.test
index e104980..7d35862 100644
--- a/tests/bgerror.test
+++ b/tests/bgerror.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: bgerror.test,v 1.5 2003/04/01 21:06:15 dgp Exp $
+# RCS: @(#) $Id: bgerror.test,v 1.6 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -58,16 +58,3 @@ catch {rename tkerror {}}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/bind.test b/tests/bind.test
index 9ecee81..9117204 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: bind.test,v 1.12 2003/04/01 21:06:16 dgp Exp $
+# RCS: @(#) $Id: bind.test,v 1.13 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -2051,189 +2051,187 @@ test bind-22.18 {HandleEventGenerate} {
     # Bug 411307
     list [catch {event gen . <a> -root 98765} msg] $msg
 } {1 {bad window name/identifier "98765"}}
-set i 19
 foreach check {
-    {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
-    {<Configure> %a {-above .b} {[winfo id .b]}}
-    {<Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}}
-    {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
-    {<Key> %b    {-above .} {{1 {<Key> event doesn't accept "-above" option}}}}
-
-    {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}    
-    {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
-    {<Key> %k	    {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}}
-
-    {<Button> %b    {-button xyz} {{1 {expected integer but got "xyz"}}}}
-    {<Button> %b    {-button 1} 1}
-    {<ButtonRelease> %b    {-button 1} 1}
-    {<Key> %k	    {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}}
-
-    {<Expose> %c    {-count xyz} {{1 {expected integer but got "xyz"}}}}
-    {<Expose> %c    {-count 20} 20}
-    {<Key> %b	    {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}}
-
-    {<Enter> %d	    {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}}
-    {<FocusIn> %d   {-detail NotifyVirtual} {{}}}
-    {<Enter> %d	    {-detail NotifyVirtual} NotifyVirtual}
-    {<Key> %k	    {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}}
-
-    {<Enter> %f	    {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
-    {<Enter> %f	    {-focus 1} 1}
-    {<Key> %k	    {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}}
-
-    {<Expose> %h    {-height xyz} {{1 {bad screen distance "xyz"}}}}
-    {<Expose> %h    {-height 2i} {[winfo pixels .b.f 2i]}}
-    {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}}
-    {<Key> %k	    {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}}
-
-    {<Key> %k	    {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
-    {<Key> %k	    {-keycode 20} 20}
-    {<Button> %b    {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}}
-
-    {<Key> %K	    {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
-    {<Key> %K	    {-keysym a} a}
-    {<Button> %b    {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}}
-
-    {<Enter> %m	    {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}}
-    {<Enter> %m	    {-mode NotifyNormal} NotifyNormal}
-    {<FocusIn> %m   {-mode NotifyNormal} {{}}}
-    {<Key> %k	    {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}}
-
-    {<Map> %o	    {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
-    {<Map> %o	    {-override 1} 1}
-    {<Reparent> %o  {-override 1} 1}
-    {<Configure> %o {-override 1} 1}
-    {<Key> %k	    {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}}
-
-    {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}}
-    {<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
-    {<Key> %k	    {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}}
-
-    {<Key> %R	    {-root .xyz} {{1 {bad window path name ".xyz"}}}}
-    {<Key> %R	    {-root .b} {[winfo id .b]}}
-    {<Key> %R	    {-root xyz} {{1 {bad window name/identifier "xyz"}}}}
-    {<Key> %R	    {-root [winfo id .b]} {[winfo id .b]}}
-    {<Button> %R    {-root .b} {[winfo id .b]}}
-    {<ButtonRelease> %R    {-root .b} {[winfo id .b]}}
-    {<Motion> %R    {-root .b} {[winfo id .b]}}
-    {<<Paste>> %R   {-root .b} {[winfo id .b]}}
-    {<Enter> %R	    {-root .b} {[winfo id .b]}}
-    {<Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}}
-
-    {<Key> %X	    {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
-    {<Key> %X	    {-rootx 2i} {[winfo pixels .b.f 2i]}}
-    {<Button> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
-    {<ButtonRelease> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
-    {<Motion> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
-    {<<Paste>> %X   {-rootx 2i} {[winfo pixels .b.f 2i]}}
-    {<Enter> %X	    {-rootx 2i} {[winfo pixels .b.f 2i]}}
-    {<Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}}
-
-    {<Key> %Y	    {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
-    {<Key> %Y	    {-rooty 2i} {[winfo pixels .b.f 2i]}}
-    {<Button> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
-    {<ButtonRelease> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
-    {<Motion> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
-    {<<Paste>> %Y   {-rooty 2i} {[winfo pixels .b.f 2i]}}
-    {<Enter> %Y	    {-rooty 2i} {[winfo pixels .b.f 2i]}}
-    {<Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}}
-
-    {<Key> %E	    {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
-    {<Key> %E	    {-sendevent 1} 1}
-    {<Key> %E	    {-sendevent yes} 1}
-    {<Key> %E	    {-sendevent 43} 43}
-
-    {<Key> %#	    {-serial xyz} {{1 {expected integer but got "xyz"}}}}
-    {<Key> %#	    {-serial 100} 100}
-
-    {<Key> %s	    {-state xyz} {{1 {expected integer but got "xyz"}}}}
-    {<Key> %s	    {-state 1} 1}
-    {<Button> %s    {-state 1025} 1025}
-    {<ButtonRelease> %s    {-state 1025} 1025}
-    {<Motion> %s    {-state 1} 1}
-    {<<Paste>> %s   {-state 1} 1}
-    {<Enter> %s	    {-state 1} 1}
-    {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}}
-    {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
-    {<Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}}
-
-    {<Key> %S	    {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
-    {<Key> %S	    {-subwindow .b} {[winfo id .b]}}
-    {<Key> %S	    {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}}
-    {<Key> %S	    {-subwindow [winfo id .b]} {[winfo id .b]}}
-    {<Button> %S    {-subwindow .b} {[winfo id .b]}}
-    {<ButtonRelease> %S    {-subwindow .b} {[winfo id .b]}}
-    {<Motion> %S    {-subwindow .b} {[winfo id .b]}}
-    {<<Paste>> %S   {-subwindow .b} {[winfo id .b]}}
-    {<Enter> %S	    {-subwindow .b} {[winfo id .b]}}
-    {<Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}}
-
-    {<Key> %t	    {-time xyz} {{1 {expected integer but got "xyz"}}}}
-    {<Key> %t	    {-time 100} 100}
-    {<Button> %t    {-time 100} 100}
-    {<ButtonRelease> %t    {-time 100} 100}
-    {<Motion> %t    {-time 100} 100}
-    {<<Paste>> %t   {-time 100} 100}
-    {<Enter> %t	    {-time 100} 100}
-    {<Property> %t  {-time 100} 100}
-    {<Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}}
-
-    {<Expose> %w    {-width xyz} {{1 {bad screen distance "xyz"}}}}
-    {<Expose> %w    {-width 2i} {[winfo pixels .b.f 2i]}}
-    {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}}
-    {<Key> %k	    {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}}
-
-    {<Unmap> %W    {-window .xyz} {{1 {bad window path name ".xyz"}}}}
-    {<Unmap> %W    {-window .b.f} .b.f}
-    {<Unmap> %W    {-window xyz} {{1 {bad window name/identifier "xyz"}}}}
-    {<Unmap> %W    {-window [winfo id .b.f]} .b.f}
-    {<Unmap> %W	    {-window .b.f} .b.f}
-    {<Map> %W	    {-window .b.f} .b.f}
-    {<Reparent> %W  {-window .b.f} .b.f}
-    {<Configure> %W {-window .b.f} .b.f}
-    {<Gravity> %W   {-window .b.f} .b.f}
-    {<Circulate> %W {-window .b.f} .b.f}
-    {<Key> %W	    {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}}
-
-    {<Key> %x	    {-x xyz} {{1 {bad screen distance "xyz"}}}}
-    {<Key> %x	    {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<Button> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<ButtonRelease> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<Motion> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<<Paste>> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<Enter> %x	    {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<Expose> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<Gravity> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<Reparent> %x  {-x 2i} {[winfo pixels .b.f 2i]}}
-    {<Map> %x	    {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}}
-
-    {<Key> %y	    {-y xyz} {{1 {bad screen distance "xyz"}}}}
-    {<Key> %y	    {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<Button> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<ButtonRelease> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<Motion> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<<Paste>> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<Enter> %y	    {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<Expose> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<Gravity> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<Reparent> %y  {-y 2i} {[winfo pixels .b.f 2i]}}
-    {<Map> %y	    {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}}
-
-    {<Key> %k	    {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -warp, -width, -window, -x, or -y}}}}
+    {bind-22.19 <Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
+    {bind-22.20 <Configure> %a {-above .b} {[winfo id .b]}}
+    {bind-22.21 <Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}}
+    {bind-22.22 <Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
+    {bind-22.23 <Key> %b       {-above .} {{1 {<Key> event doesn't accept "-above" option}}}}
+
+    {bind-22.24 <Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}    
+    {bind-22.25 <Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.26 <Key> %k       {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}}
+
+    {bind-22.27 <Button> %b    {-button xyz} {{1 {expected integer but got "xyz"}}}}
+    {bind-22.28 <Button> %b    {-button 1} 1}
+    {bind-22.29 <ButtonRelease> %b {-button 1} 1}
+    {bind-22.30 <Key> %k       {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}}
+
+    {bind-22.31 <Expose> %c    {-count xyz} {{1 {expected integer but got "xyz"}}}}
+    {bind-22.32 <Expose> %c    {-count 20} 20}
+    {bind-22.33 <Key> %b       {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}}
+
+    {bind-22.34 <Enter> %d     {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}}
+    {bind-22.35 <FocusIn> %d   {-detail NotifyVirtual} {{}}}
+    {bind-22.36 <Enter> %d     {-detail NotifyVirtual} NotifyVirtual}
+    {bind-22.37 <Key> %k       {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}}
+
+    {bind-22.38 <Enter> %f     {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
+    {bind-22.39 <Enter> %f     {-focus 1} 1}
+    {bind-22.40 <Key> %k       {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}}
+
+    {bind-22.41 <Expose> %h    {-height xyz} {{1 {bad screen distance "xyz"}}}}
+    {bind-22.42 <Expose> %h    {-height 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.43 <Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.44 <Key> %k       {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}}
+
+    {bind-22.45 <Key> %k       {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
+    {bind-22.46 <Key> %k       {-keycode 20} 20}
+    {bind-22.47 <Button> %b    {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}}
+
+    {bind-22.48 <Key> %K       {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
+    {bind-22.49 <Key> %K       {-keysym a} a}
+    {bind-22.50 <Button> %b    {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}}
+
+    {bind-22.51 <Enter> %m     {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}}
+    {bind-22.52 <Enter> %m     {-mode NotifyNormal} NotifyNormal}
+    {bind-22.53 <FocusIn> %m   {-mode NotifyNormal} {{}}}
+    {bind-22.54 <Key> %k       {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}}
+
+    {bind-22.55 <Map> %o       {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
+    {bind-22.56 <Map> %o       {-override 1} 1}
+    {bind-22.57 <Reparent> %o  {-override 1} 1}
+    {bind-22.58 <Configure> %o {-override 1} 1}
+    {bind-22.59 <Key> %k       {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}}
+
+    {bind-22.60 <Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}}
+    {bind-22.61 <Circulate> %p {-place PlaceOnTop} PlaceOnTop}
+    {bind-22.62 <Key> %k       {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}}
+
+    {bind-22.63 <Key> %R       {-root .xyz} {{1 {bad window path name ".xyz"}}}}
+    {bind-22.64 <Key> %R       {-root .b} {[winfo id .b]}}
+    {bind-22.65 <Key> %R       {-root xyz} {{1 {bad window name/identifier "xyz"}}}}
+    {bind-22.66 <Key> %R       {-root [winfo id .b]} {[winfo id .b]}}
+    {bind-22.67 <Button> %R    {-root .b} {[winfo id .b]}}
+    {bind-22.68 <ButtonRelease> %R {-root .b} {[winfo id .b]}}
+    {bind-22.69 <Motion> %R    {-root .b} {[winfo id .b]}}
+    {bind-22.70 <<Paste>> %R   {-root .b} {[winfo id .b]}}
+    {bind-22.71 <Enter> %R     {-root .b} {[winfo id .b]}}
+    {bind-22.72 <Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}}
+
+    {bind-22.73 <Key> %X       {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
+    {bind-22.74 <Key> %X       {-rootx 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.75 <Button> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.76 <ButtonRelease> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.77 <Motion> %X    {-rootx 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.78 <<Paste>> %X   {-rootx 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.79 <Enter> %X     {-rootx 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.80 <Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}}
+
+    {bind-22.81 <Key> %Y       {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
+    {bind-22.82 <Key> %Y       {-rooty 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.83 <Button> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.84 <ButtonRelease> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.85 <Motion> %Y    {-rooty 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.86 <<Paste>> %Y   {-rooty 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.87 <Enter> %Y     {-rooty 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.88 <Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}}
+
+    {bind-22.89 <Key> %E       {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
+    {bind-22.90 <Key> %E       {-sendevent 1} 1}
+    {bind-22.91 <Key> %E       {-sendevent yes} 1}
+    {bind-22.92 <Key> %E       {-sendevent 43} 43}
+
+    {bind-22.93 <Key> %#       {-serial xyz} {{1 {expected integer but got "xyz"}}}}
+    {bind-22.94 <Key> %#       {-serial 100} 100}
+
+    {bind-22.95 <Key> %s       {-state xyz} {{1 {expected integer but got "xyz"}}}}
+    {bind-22.96 <Key> %s       {-state 1} 1}
+    {bind-22.97 <Button> %s    {-state 1025} 1025}
+    {bind-22.98 <ButtonRelease> %s {-state 1025} 1025}
+    {bind-22.99 <Motion> %s    {-state 1} 1}
+    {bind-22.100 <<Paste>> %s  {-state 1} 1}
+    {bind-22.101 <Enter> %s    {-state 1} 1}
+    {bind-22.102 <Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}}
+    {bind-22.103 <Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
+    {bind-22.104 <Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}}
+
+    {bind-22.105 <Key> %S      {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
+    {bind-22.106 <Key> %S      {-subwindow .b} {[winfo id .b]}}
+    {bind-22.107 <Key> %S      {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}}
+    {bind-22.108 <Key> %S      {-subwindow [winfo id .b]} {[winfo id .b]}}
+    {bind-22.109 <Button> %S   {-subwindow .b} {[winfo id .b]}}
+    {bind-22.110 <ButtonRelease> %S {-subwindow .b} {[winfo id .b]}}
+    {bind-22.111 <Motion> %S   {-subwindow .b} {[winfo id .b]}}
+    {bind-22.112 <<Paste>> %S  {-subwindow .b} {[winfo id .b]}}
+    {bind-22.113 <Enter> %S    {-subwindow .b} {[winfo id .b]}}
+    {bind-22.114 <Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}}
+
+    {bind-22.115 <Key> %t      {-time xyz} {{1 {expected integer but got "xyz"}}}}
+    {bind-22.116 <Key> %t      {-time 100} 100}
+    {bind-22.117 <Button> %t   {-time 100} 100}
+    {bind-22.118 <ButtonRelease> %t {-time 100} 100}
+    {bind-22.119 <Motion> %t   {-time 100} 100}
+    {bind-22.120 <<Paste>> %t  {-time 100} 100}
+    {bind-22.121 <Enter> %t    {-time 100} 100}
+    {bind-22.122 <Property> %t {-time 100} 100}
+    {bind-22.123 <Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}}
+
+    {bind-22.124 <Expose> %w   {-width xyz} {{1 {bad screen distance "xyz"}}}}
+    {bind-22.125 <Expose> %w   {-width 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.126 <Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.127 <Key> %k      {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}}
+
+    {bind-22.128 <Unmap> %W    {-window .xyz} {{1 {bad window path name ".xyz"}}}}
+    {bind-22.129 <Unmap> %W    {-window .b.f} .b.f}
+    {bind-22.130 <Unmap> %W    {-window xyz} {{1 {bad window name/identifier "xyz"}}}}
+    {bind-22.131 <Unmap> %W    {-window [winfo id .b.f]} .b.f}
+    {bind-22.132 <Unmap> %W    {-window .b.f} .b.f}
+    {bind-22.133 <Map> %W      {-window .b.f} .b.f}
+    {bind-22.134 <Reparent> %W {-window .b.f} .b.f}
+    {bind-22.135 <Configure> %W {-window .b.f} .b.f}
+    {bind-22.136 <Gravity> %W  {-window .b.f} .b.f}
+    {bind-22.137 <Circulate> %W {-window .b.f} .b.f}
+    {bind-22.138 <Key> %W      {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}}
+
+    {bind-22.139 <Key> %x      {-x xyz} {{1 {bad screen distance "xyz"}}}}
+    {bind-22.140 <Key> %x      {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.141 <Button> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.142 <ButtonRelease> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.143 <Motion> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.144 <<Paste>> %x  {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.145 <Enter> %x    {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.146 <Expose> %x   {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.147 <Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.148 <Gravity> %x  {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.149 <Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.150 <Map> %x      {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}}
+
+    {bind-22.151 <Key> %y      {-y xyz} {{1 {bad screen distance "xyz"}}}}
+    {bind-22.152 <Key> %y      {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.153 <Button> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.154 <ButtonRelease> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.155 <Motion> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.156 <<Paste>> %y  {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.157 <Enter> %y    {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.158 <Expose> %y   {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.159 <Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.160 <Gravity> %y  {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.161 <Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+    {bind-22.162 <Map> %y      {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}}
+
+    {bind-22.163 <Key> %k      {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -warp, -width, -window, -x, or -y}}}}
 } {
-    set event [lindex $check 0]
-    test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" {
+    lassign $check name event substitution generator result
+    test $name "HandleEventGenerate: options $event $generator" {
 	setup
-	bind .b.f $event "lappend x [lindex $check 1]"
+	bind .b.f $event "lappend x $substitution"
 	set x {}
-	if [catch {eval event gen .b.f $event [lindex $check 2]} msg] {
+	if [catch {eval event gen .b.f $event $generator} msg] {
 	    set x [list 1 $msg]
 	}
 	set x
-    } [eval set x [lindex $check 3]]
-    incr i
+    } [eval set x $result]
 }
 test bind-23.1 {GetVirtualEventUid procedure} {
     list [catch {event info <<asd} msg] $msg
@@ -2432,48 +2430,49 @@ test bind-25.17 {ParseEventDescription} {
     setup
     list [catch {event add <<xyz>> <<abc>>} msg] $msg
 } {1 {virtual event not allowed in definition of another virtual event}}
-set i 1
 foreach check {
-    {{<Control- a>} <Control-Key-a>}
-    {<Shift-a> <Shift-Key-a>}
-    {<Lock-a> <Lock-Key-a>}
-    {<Meta---a> <Meta-Key-a>}
-    {<M-a> <Meta-Key-a>}
-    {<Alt-a> <Alt-Key-a>}
-    {<B1-a> <B1-Key-a>}
-    {<B2-a> <B2-Key-a>}
-    {<B3-a> <B3-Key-a>}
-    {<B4-a> <B4-Key-a>}
-    {<B5-a> <B5-Key-a>}
-    {<Button1-a> <B1-Key-a>}
-    {<Button2-a> <B2-Key-a>}
-    {<Button3-a> <B3-Key-a>}
-    {<Button4-a> <B4-Key-a>}
-    {<Button5-a> <B5-Key-a>}
-    {<M1-a> <Mod1-Key-a>}
-    {<M2-a> <Mod2-Key-a>}
-    {<M3-a> <Mod3-Key-a>}
-    {<M4-a> <Mod4-Key-a>}
-    {<M5-a> <Mod5-Key-a>}
-    {<Mod1-a> <Mod1-Key-a>}
-    {<Mod2-a> <Mod2-Key-a>}
-    {<Mod3-a> <Mod3-Key-a>}
-    {<Mod4-a> <Mod4-Key-a>}
-    {<Mod5-a> <Mod5-Key-a>}
-    {<Double-a> <Double-Key-a>}
-    {<Triple-a> <Triple-Key-a>}
-    {{<Double 1>} <Double-Button-1>}
-    {<Triple-1> <Triple-Button-1>}
-    {{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>}
+    {bind-25.1  {<Control- a>} <Control-Key-a>}
+    {bind-25.2  <Shift-a>   <Shift-Key-a>}
+    {bind-25.3  <Lock-a>    <Lock-Key-a>}
+    {bind-25.4  <Meta---a>  <Meta-Key-a>}
+    {bind-25.5  <M-a>       <Meta-Key-a>}
+    {bind-25.6  <Alt-a>     <Alt-Key-a>}
+    {bind-25.7  <B1-a>      <B1-Key-a>}
+    {bind-25.8  <B2-a>      <B2-Key-a>}
+    {bind-25.9  <B3-a>      <B3-Key-a>}
+    {bind-25.10 <B4-a>      <B4-Key-a>}
+    {bind-25.11 <B5-a>      <B5-Key-a>}
+    {bind-25.12 <Button1-a> <B1-Key-a>}
+    {bind-25.13 <Button2-a> <B2-Key-a>}
+    {bind-25.14 <Button3-a> <B3-Key-a>}
+    {bind-25.15 <Button4-a> <B4-Key-a>}
+    {bind-25.16 <Button5-a> <B5-Key-a>}
+    {bind-25.17 <M1-a>      <Mod1-Key-a>}
+    {bind-25.18 <M2-a>      <Mod2-Key-a>}
+    {bind-25.19 <M3-a>      <Mod3-Key-a>}
+    {bind-25.20 <M4-a>      <Mod4-Key-a>}
+    {bind-25.21 <M5-a>      <Mod5-Key-a>}
+    {bind-25.22 <Mod1-a>    <Mod1-Key-a>}
+    {bind-25.23 <Mod2-a>    <Mod2-Key-a>}
+    {bind-25.24 <Mod3-a>    <Mod3-Key-a>}
+    {bind-25.25 <Mod4-a>    <Mod4-Key-a>}
+    {bind-25.26 <Mod5-a>    <Mod5-Key-a>}
+    {bind-25.27 <Double-a>  <Double-Key-a>}
+    {bind-25.28 <Triple-a>  <Triple-Key-a>}
+    {bind-25.29 {<Double 1>} <Double-Button-1>}
+    {bind-25.30 <Triple-1>  <Triple-Button-1>}
+    {bind-25.31 {<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>}
 } {
-    test bind-25.$i {modifier names} {
+    lassign $check name shortBind longBind
+    test $name {modifier names} -setup {
 	catch {destroy .b.f}
 	frame .b.f -class Test -width 150 -height 100
-	bind .b.f [lindex $check 0] foo
+    } -body {
+	bind .b.f $shortBind foo
 	bind .b.f
-    } [lindex $check 1]
-    bind .b.f [lindex $check 1] {}
-    incr i
+    } -result $longBind -cleanup {
+	bind .b.f [lindex $check 1] {}
+    }
 }
 
 foreach event [bind Test] {
@@ -2501,72 +2500,97 @@ test bind-26.3 {event names} {
     destroy .b.f
     set x
 } {<Destroy> destroyed}
-set i 4
 foreach check { 
-    {Motion Motion}
-    {Button Button}
-    {ButtonPress Button}
-    {ButtonRelease ButtonRelease}
-    {Colormap Colormap}
-    {Enter Enter}
-    {Leave Leave}
-    {Expose Expose}
-    {Key Key}
-    {KeyPress Key}
-    {KeyRelease KeyRelease}
-    {Property Property}
-    {Visibility Visibility}
-    {Activate Activate}
-    {Deactivate Deactivate}
+    {bind-26.4  Motion     Motion}
+    {bind-26.5  Button     Button}
+    {bind-26.6  ButtonPress   Button}
+    {bind-26.7  ButtonRelease ButtonRelease}
+    {bind-26.8  Colormap   Colormap}
+    {bind-26.9  Enter      Enter}
+    {bind-26.10 Leave      Leave}
+    {bind-26.11 Expose     Expose}
+    {bind-26.12 Key        Key}
+    {bind-26.13 KeyPress   Key}
+    {bind-26.14 KeyRelease KeyRelease}
+    {bind-26.15 Property   Property}
+    {bind-26.16 Visibility Visibility}
+    {bind-26.17 Activate   Activate}
+    {bind-26.18 Deactivate Deactivate}
 } {
-    set event [lindex $check 0]
-    test bind-26.$i {event names} {
+    lassign $check name event canonicalEvent
+    test $name "event names: $event" {
 	setup
 	bind .b.f <$event> "set x {event $event}"
 	set x xyzzy
 	event gen .b.f <$event>
 	list $x [bind .b.f]
-    } [list "event $event" <[lindex $check 1]>]
-    incr i
+    } [list "event $event" <$canonicalEvent>]
 }
+# These events require an extra argument to [event generate]
 foreach check { 
-    {Circulate Circulate}
-    {Configure Configure}
-    {Gravity Gravity}
-    {Map Map}
-    {Reparent Reparent}
-    {Unmap Unmap}
+    {bind-26.19 Circulate Circulate}
+    {bind-26.20 Configure Configure}
+    {bind-26.21 Gravity   Gravity}
+    {bind-26.22 Map       Map}
+    {bind-26.23 Reparent  Reparent}
+    {bind-26.24 Unmap     Unmap}
 } {
-    set event [lindex $check 0]
-    test bind-26.$i {event names} {
+    lassign $check name event canonicalEvent
+    test $name "event names: $event" {
 	setup
 	bind .b.f <$event> "set x {event $event}"
 	set x xyzzy
 	event gen .b.f <$event> -window .b.f
 	list $x [bind .b.f]
-    } [list "event $event" <[lindex $check 1]>]
-    incr i
+    } [list "event $event" <$canonicalEvent>]
 }
 
-
 test bind-27.1 {button names} {
     list [catch {bind .b <Expose-1> foo} msg] $msg
 } {1 {specified button "1" for non-button event}}
 test bind-27.2 {button names} {
     list [catch {bind .b <Button-6> foo} msg] $msg
 } {1 {specified keysym "6" for non-key event}}
-set i 3
-foreach button {1 2 3 4 5} {
-    test bind-27.$i {button names} {
-	setup
-	bind .b.f <Button-$button> "lappend x \"button $button\""
-	set x [bind .b.f]
-	event gen .b.f <Button-$button>
-	event gen .b.f <ButtonRelease-$button>
-	set x
-    } [list <Button-$button> "button $button"]
-    incr i
-}
+test bind-27.3 {button names} {
+    setup
+    bind .b.f <Button-1> {lappend x "button 1"}
+    set x [bind .b.f]
+    event gen .b.f <Button-1>
+    event gen .b.f <ButtonRelease-1>
+    set x
+} {<Button-1> {button 1}}
+test bind-27.4 {button names} {
+    setup
+    bind .b.f <Button-2> {lappend x "button 2"}
+    set x [bind .b.f]
+    event gen .b.f <Button-2>
+    event gen .b.f <ButtonRelease-2>
+    set x
+} {<Button-2> {button 2}}
+test bind-27.5 {button names} {
+    setup
+    bind .b.f <Button-3> {lappend x "button 3"}
+    set x [bind .b.f]
+    event gen .b.f <Button-3>
+    event gen .b.f <ButtonRelease-3>
+    set x
+} {<Button-3> {button 3}}
+test bind-27.6 {button names} {
+    setup
+    bind .b.f <Button-4> {lappend x "button 4"}
+    set x [bind .b.f]
+    event gen .b.f <Button-4>
+    event gen .b.f <ButtonRelease-4>
+    set x
+} {<Button-4> {button 4}}
+test bind-27.7 {button names} {
+    setup
+    bind .b.f <Button-5> {lappend x "button 5"}
+    set x [bind .b.f]
+    event gen .b.f <Button-5>
+    event gen .b.f <ButtonRelease-5>
+    set x
+} {<Button-5> {button 5}}
 
 test bind-28.1 {keysym names} {
     list [catch {bind .b <Expose-a> foo} msg] $msg
@@ -2583,46 +2607,41 @@ test bind-28.4 {keysym names} {
     bind .b.f <a> foo
     bind .b.f
 } a
-set i 5
 foreach check {
-    {a 0 a}
-    {space 0 <Key-space>}
-    {Return 0 <Key-Return>}
-    {X 1 X}
+    {bind-28.5 a      0 a}
+    {bind-28.6 space  0 <Key-space>}
+    {bind-28.7 Return 0 <Key-Return>}
+    {bind-28.8 X      1 X}
 } {
-    set keysym [lindex $check 0]
-    test bind-28.$i {keysym names} {
+    lassign $check name keysym state result
+    test $name {keysym names} {
 	setup
 	bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\""
 	bind .b.f <Key-x> "lappend x {bad binding match}"
 	set x [lsort [bind .b.f]]
-	event gen .b.f <Key-$keysym> -state [lindex $check 1]
+	event gen .b.f <Key-$keysym> -state $state
 	set x
-    } [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"]
-    incr i
+    } [concat [lsort "x $result"] "{keysym $keysym}"]
 }
 
 test bind-29.1 {dummy test to help ensure proper numbering} {} {}
 setup
 bind .b.f <KeyPress> {set x %K}
-set i 2
 foreach check {
-    {a 0 a}
-    {x 1 X}
-    {x 2 X}
-    {space 0 space}
-    {F1 1 F1}
+    {bind-29.2 a     0 a}
+    {bind-29.3 x     1 X}
+    {bind-29.4 x     2 X}
+    {bind-29.5 space 0 space}
+    {bind-29.6 F1    1 F1}
 } {
-    test bind-29.$i {GetKeySym procedure} {nonPortable} {
+    lassign $check name keysym state result
+    test $name {GetKeySym procedure} nonPortable {
 	set x nothing
-	event gen .b.f <KeyPress> -keysym [lindex $check 0] \
-		-state [lindex $check 1]
+	event gen .b.f <KeyPress> -keysym $keysym -state $state
 	set x
-    } [lindex $check 2]
-    incr i
+    } $result
 }
 
-
 proc bgerror msg {
     global x errorInfo
     set x [list $msg $errorInfo]
diff --git a/tests/bitmap.test b/tests/bitmap.test
index f81613d..95d04a9 100644
--- a/tests/bitmap.test
+++ b/tests/bitmap.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: bitmap.test,v 1.4 2003/04/01 21:06:17 dgp Exp $
+# RCS: @(#) $Id: bitmap.test,v 1.5 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -93,16 +93,3 @@ destroy .t
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/border.test b/tests/border.test
index 0bf08b8..81cea0b 100644
--- a/tests/border.test
+++ b/tests/border.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: border.test,v 1.4 2003/04/01 21:06:17 dgp Exp $
+# RCS: @(#) $Id: border.test,v 1.5 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -163,16 +163,3 @@ if {[testConstraint pseudocolor8]} {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/button.test b/tests/button.test
index bc81d9a..b536078 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: button.test,v 1.15 2004/02/18 00:40:24 hobbs Exp $
+# RCS: @(#) $Id: button.test,v 1.16 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -42,7 +42,9 @@ foreach test {
 	    {unknown color name "non-existent"} {1 1 1 1}}
     {-activeforeground #ff0000 #ff0000 non-existent
 	    {unknown color name "non-existent"} {1 1 1 1}}
-    {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} {1 1 1 1}}
+    {-anchor nw nw bogus
+	    {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}
+	    {1 1 1 1}}
     {-background #ff0000 #ff0000 non-existent
 	    {unknown color name "non-existent"} {1 1 1 1}}
     {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}}
@@ -52,7 +54,9 @@ foreach test {
 	    {1 1 1 1}}
     {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}}
     {-command "set x" {set x} {} {} {0 1 1 1}}
-    {-compound left left bogus {bad compound "bogus": must be bottom, center, left, none, right, or top} {1 1 1 1}}
+    {-compound left left bogus
+	    {bad compound "bogus": must be bottom, center, left, none, right, or top}
+	    {1 1 1 1}}
     {-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}}
     {-default active active huh?
 	    {bad default "huh?": must be active, disabled, or normal}
@@ -72,47 +76,57 @@ foreach test {
     {-image image1 image1 bogus {image "bogus" doesn't exist} {1 1 1 1}}
     {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}
 	    {0 0 1 1}}
-    {-justify right right bogus {bad justification "bogus": must be left, right, or center} {1 1 1 1}}
-    {-offrelief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 0 1 1}}
+    {-justify right right bogus
+	    {bad justification "bogus": must be left, right, or center}
+	    {1 1 1 1}}
+    {-offrelief flat flat 1.5
+	    {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}
+	    {0 0 1 1}}
     {-offvalue lousy lousy {} {} {0 0 1 0}}
     {-onvalue fantastic fantastic {} {} {0 0 1 0}}
-    {-overrelief "" "" 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 1 1 1}}
+    {-overrelief "" "" 1.5
+	    {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}
+	    {0 1 1 1}}
     {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
     {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
     {-repeatdelay 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
     {-repeatinterval 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
-    {-relief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {1 1 1 1}}
+    {-relief flat flat 1.5
+	    {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}
+	    {1 1 1 1}}
     {-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}}
     {-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
-    {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal} {1 1 1 1}}
+    {-state normal normal bogus
+	    {bad state "bogus": must be active, disabled, or normal}
+	    {1 1 1 1}}
     {-takefocus "any string" "any string" {} {} {1 1 1 1}}
     {-text "Sample text" {Sample text} {} {} {1 1 1 1}}
     {-textvariable i i {} {} {1 1 1 1}}
-    {-tristateimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
+    {-tristateimage image1 image1 bogus {image "bogus" doesn't exist}
+	    {0 0 1 1}}
     {-tristatevalue unknowable unknowable {} {} {0 0 1 1}}
     {-underline 5 5 3p {expected integer but got "3p"} {1 1 1 1}}
     {-value anyString anyString {} {} {0 0 0 1}}
     {-width 402 402 3p {expected integer but got "3p"} {1 1 1 1}}
     {-wraplength 100 100 6x {bad screen distance "6x"} {1 1 1 1}}
 } {
-    set name [lindex $test 0]
-    set classes [lindex $test 5]
-    foreach w {.l .b .c .r} hasOption [lindex $test 5] {
-	if $hasOption {
+    lassign $test name value okResult badValue badResult classes
+    foreach w {.l .b .c .r} hasOption $classes {
+	if {$hasOption} {
 	    test button-1.$i {configuration options} testImageType {
-		$w configure $name [lindex $test 1]
+		$w configure $name $value
 		lindex [$w configure $name] 4
-	    } [lindex $test 2]
+	    } $okResult
 	    incr i
-	    if {[lindex $test 3] != ""} {
+	    if {$badValue ne ""} {
 		test button-1.$i {configuration options} testImageType {
-		    list [catch {$w configure $name [lindex $test 3]} msg] $msg
-		} [list 1 [lindex $test 4]]
+		    list [catch {$w configure $name $badValue} msg] $msg
+		} [list 1 $badResult]
 	    }
 	    $w configure $name [lindex [$w configure $name] 3]
 	} else {
 	    test button-1.$i {configuration options} testImageType {
-		list [catch {$w configure $name [lindex $test 1]} msg] $msg
+		list [catch {$w configure $name $value} msg] $msg
 	    } "1 {unknown option \"$name\"}"
 	}
     }
diff --git a/tests/canvImg.test b/tests/canvImg.test
index ec6fb6b..5a7cd71 100644
--- a/tests/canvImg.test
+++ b/tests/canvImg.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvImg.test,v 1.7 2003/05/08 09:35:41 dkf Exp $
+# RCS: @(#) $Id: canvImg.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -225,37 +225,36 @@ test canvImg-7.2 {DisplayImage procedure, no image} {
     update
 } {}
 
-set i 1
 .c delete all
 if {[testConstraint testImageType]} {
     .c create image 50 100 -image foo -tags image -anchor nw
 }
 .c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {}
 foreach check {
-    {{50 70 80 81} {70 90} {rect}}
-    {{50 70 80 79} {70 90} {image}}
-    {{99 70 110 81} {90 90} {rect}}
-    {{101 70 110 79} {90 90} {image}}
-    {{99 100 110 115} {90 110} {rect}}
-    {{101 100 110 115} {90 110} {image}}
-    {{99 134 110 145} {90 125} {rect}}
-    {{101 136 110 145} {90 125} {image}}
-    {{50 134 80 145} {70 125} {rect}}
-    {{50 136 80 145} {70 125} {image}}
-    {{20 134 31 145} {40 125} {rect}}
-    {{20 136 29 145} {40 125} {image}}
-    {{20 100 31 115} {40 110} {rect}}
-    {{20 100 29 115} {40 110} {image}}
-    {{20 70 31 80} {40 90} {rect}}
-    {{20 70 29 79} {40 90} {image}}
-    {{60 70 69 109} {70 110} {image}}
-    {{60 70 71 111} {70 110} {rect}}
+    {canvImg-8.1   {50 70 80 81}     {70 90}  rect}
+    {canvImg-8.2   {50 70 80 79}     {70 90}  image}
+    {canvImg-8.3   {99 70 110 81}    {90 90}  rect}
+    {canvImg-8.4   {101 70 110 79}   {90 90}  image}
+    {canvImg-8.5   {99 100 110 115}  {90 110} rect}
+    {canvImg-8.6   {101 100 110 115} {90 110} image}
+    {canvImg-8.7   {99 134 110 145}  {90 125} rect}
+    {canvImg-8.8   {101 136 110 145} {90 125} image}
+    {canvImg-8.9   {50 134 80 145}   {70 125} rect}
+    {canvImg-8.10  {50 136 80 145}   {70 125} image}
+    {canvImg-8.11  {20 134 31 145}   {40 125} rect}
+    {canvImg-8.12  {20 136 29 145}   {40 125} image}
+    {canvImg-8.13  {20 100 31 115}   {40 110} rect}
+    {canvImg-8.14  {20 100 29 115}   {40 110} image}
+    {canvImg-8.15  {20 70 31 80}     {40 90}  rect}
+    {canvImg-8.16  {20 70 29 79}     {40 90}  image}
+    {canvImg-8.17  {60 70 69 109}    {70 110} image}
+    {canvImg-8.18  {60 70 71 111}    {70 110} rect}
 } {
-    test canvImg-8.$i {ImageToPoint procedure} testImageType {
-	eval .c coords rect [lindex $check 0]
-	.c gettags [eval .c find closest [lindex $check 1]]
-    } [lindex $check 2]
-    incr i
+    lassign $check name rectCoords testPoint result
+    test $name {ImageToPoint procedure} testImageType {
+	.c coords rect {expand}$rectCoords
+	.c gettags [.c find closest {expand}$testPoint]
+    } $result
 }
 
 .c delete all
@@ -392,16 +391,3 @@ test canvImg-11.3 {ImageChangedProc procedure} testImageType {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvPs.test b/tests/canvPs.test
index d065d53..e57b9b9 100644
--- a/tests/canvPs.test
+++ b/tests/canvPs.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvPs.test,v 1.7 2003/05/11 00:52:41 hobbs Exp $
+# RCS: @(#) $Id: canvPs.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -131,16 +131,3 @@ removeFile bar.ps
 deleteWindows
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvRect.test b/tests/canvRect.test
index a9918e1..07f3e91 100644
--- a/tests/canvRect.test
+++ b/tests/canvRect.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvRect.test,v 1.7 2003/04/01 21:06:18 dgp Exp $
+# RCS: @(#) $Id: canvRect.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -22,22 +22,27 @@ update
 set i 1
 .c create rectangle 20 20 80 80 -tag test
 foreach test {
-    {-fill #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
-    {-outline #123456 #123456 bad_color {unknown color name "bad_color"}}
-    {-stipple gray50 gray50 bogus {bitmap "bogus" not defined}}
-    {-tags {test a b c} {test a b c} {} {}}
-    {-width 6.0 6.0 abc {bad screen distance "abc"}}
+    {-fill #ff0000 #ff0000
+	    non-existent {unknown color name "non-existent"}}
+    {-outline #123456 #123456
+	    bad_color {unknown color name "bad_color"}}
+    {-stipple gray50 gray50
+	    bogus {bitmap "bogus" not defined}}
+    {-tags {test a b c} {test a b c}
+	    {} {}}
+    {-width 6.0 6.0
+	    abc {bad screen distance "abc"}}
 } {
-    set name [lindex $test 0]
-    test canvRect-1.$i {configuration options} {
-	.c itemconfigure test $name [lindex $test 1]
+    lassign $test name goodValue goodResult badValue badResult
+    test canvRect-1.$i "configuration options: good value for $name" {
+	.c itemconfigure test $name $goodValue
 	list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
-    } [list [lindex $test 2] [lindex $test 2]]
+    } [list $goodResult $goodResult]
     incr i
-    if {[lindex $test 3] != ""} {
-	test canvRect-1.$i {configuration options} {
-	    list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    if {$badValue ne ""} {
+	test canvRect-1.$i "configuration options: bad value for $name" -body {
+	    .c itemconfigure test $name $badValue
+	} -returnCodes error -result $badResult
     }
     incr i
 }
@@ -323,16 +328,3 @@ end
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvText.test b/tests/canvText.test
index 5d5acb9..4578ff0 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvText.test,v 1.13 2003/04/01 21:06:19 dgp Exp $
+# RCS: @(#) $Id: canvText.test,v 1.14 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -35,16 +35,16 @@ foreach test {
     {-text xyz xyz {} {}}
     {-width 6 6 xyz {bad screen distance "xyz"}}
 } {
-    set name [lindex $test 0]
-    test canvText-1.$i {configuration options} {
-	.c itemconfigure test $name [lindex $test 1]
+    lassign $test name goodValue goodResult badValue badResult
+    test canvText-1.$i "configuration options: good value for $name" {
+	.c itemconfigure test $name $goodValue
 	list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
-    } [list [lindex $test 2] [lindex $test 2]]
+    } [list $goodResult $goodResult]
     incr i
-    if {[lindex $test 3] != ""} {
-	test canvText-1.$i {configuration options} {
-	    list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    if {$badValue ne ""} {
+	test canvText-1.$i "configuration options: bad value for $name" -body {
+	    .c itemconfigure test $name $badValue
+	} -returnCodes error -result $badResult
     }
     incr i
 }
@@ -516,16 +516,3 @@ test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvWind.test b/tests/canvWind.test
index 37e6e34..1b07e3f 100644
--- a/tests/canvWind.test
+++ b/tests/canvWind.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvWind.test,v 1.5 2003/04/01 21:06:19 dgp Exp $
+# RCS: @(#) $Id: canvWind.test,v 1.6 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -129,16 +129,3 @@ catch {destroy .t}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvas.test b/tests/canvas.test
index 5a2b5d3..3a7daff 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-2000 Ajuba Solutions.
 # All rights reserved.
 #
-# RCS: @(#) $Id: canvas.test,v 1.17 2003/04/01 21:06:19 dgp Exp $
+# RCS: @(#) $Id: canvas.test,v 1.18 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -20,12 +20,13 @@ pack .c
 update
 set i 1
 foreach test {
-    {-background #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
+    {-background #ff0000 #ff0000
+	    non-existent {unknown color name "non-existent"}}
     {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
     {-bd 4 4 badValue {bad screen distance "badValue"}}
     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
-    {-closeenough 24 24.0 bogus {expected floating-point number but got "bogus"}}
+    {-closeenough 24 24.0
+	    bogus {expected floating-point number but got "bogus"}}
     {-confine true 1 silly {expected boolean value but got "silly"}}
     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
     {-height 2.1 2 x42 {bad screen distance "x42"}}
@@ -37,7 +38,8 @@ foreach test {
     {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
     {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
     {-insertwidth 1.3 1 6x {bad screen distance "6x"}}
-    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+    {-relief groove groove
+	    1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
     {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
     {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
     {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
@@ -46,16 +48,16 @@ foreach test {
     {-xscrollcommand {Some command} {Some command} {} {}}
     {-yscrollcommand {Another command} {Another command} {} {}}
 } {
-    set name [lindex $test 0]
-    test canvas-1.$i {configuration options} {
-	.c configure $name [lindex $test 1]
+    lassign $test name goodValue goodResult badValue badResult
+    test canvas-1.$i "configuration options: good value for $name" {
+	.c configure $name $goodValue
 	lindex [.c configure $name] 4
-    } [lindex $test 2]
+    } $goodResult
     incr i
-    if {[lindex $test 3] != ""} {
-	test canvas-1.$i {configuration options} {
-	    list [catch {.c configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    if {$badValue ne ""} {
+	test canvas-1.$i "configuration options: bad value for $name" -body {
+	    .c configure $name $badValue
+	} -returnCodes error -result $badResult
     }
     .c configure $name [lindex [.c configure $name] 3]
     incr i
@@ -454,15 +456,18 @@ proc create {w type args} {
     eval [list $w create $type] $args
 }
 foreach type {arc bitmap image line oval polygon rect text window} {
-    test canvas-15.[incr i] "basic types check: $type" {
+    incr i
+    test canvas-15.$i "basic types check: $type requires coords" -setup {
 	destroy .c; canvas .c
-	list [catch {.c create $type} msg] $msg
-    } [format {1 {wrong # args: should be ".c create %s coords ?arg arg ...?"}} $type]
-    test canvas-15.[incr i] "basic coords check: $type" {
+    } -body {
+	.c create $type
+    } -returnCodes error -result [format {wrong # args: should be ".c create %s coords ?arg arg ...?"} $type]
+    incr i
+    test canvas-15.$i "basic coords check: $type coords are paired" -setup {
 	destroy .c; canvas .c
-	list [catch {.c create $type 0} msg] \
-		[string match "wrong # coordinates: expected*" $msg]
-    } {1 1}
+    } -match glob -body {
+	.c create $type 0
+    } -returnCodes error -result "wrong # coordinates: expected*"
 }
 
 test canvas-16.1 {arc coords check} {
diff --git a/tests/choosedir.test b/tests/choosedir.test
index 98831df..d72dbcd 100644
--- a/tests/choosedir.test
+++ b/tests/choosedir.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: choosedir.test,v 1.11 2003/04/01 21:06:19 dgp Exp $
+# RCS: @(#) $Id: choosedir.test,v 1.12 2004/05/23 17:34:48 dkf Exp $
 #
 
 package require tcltest 2.1
@@ -89,7 +89,7 @@ set real [file join $dir choosedirTest]
 set parent .
 
 foreach opt {-initialdir -mustexist -parent -title} {
-    test choosedir-1.1 "tk_chooseDirectory command" unixOnly {
+    test choosedir-1.1$opt "tk_chooseDirectory command" unixOnly {
 	list [catch {tk_chooseDirectory $opt} msg] $msg
     } [list 1 "value for \"$opt\" missing"]
 }
diff --git a/tests/clipboard.test b/tests/clipboard.test
index 2793aaf..b8530a6 100644
--- a/tests/clipboard.test
+++ b/tests/clipboard.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: clipboard.test,v 1.7 2003/04/01 21:06:20 dgp Exp $
+# RCS: @(#) $Id: clipboard.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
 
 #
 # Note: Multiple display clipboard handling will only be tested if the
@@ -244,16 +244,3 @@ test clipboard-7.16 {Tk_ClipboardCmd procedure} {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/clrpick.test b/tests/clrpick.test
index 5e19770..70f1a52 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: clrpick.test,v 1.9 2004/03/17 18:15:49 das Exp $
+# RCS: @(#) $Id: clrpick.test,v 1.10 2004/05/23 17:34:48 dkf Exp $
 #
 
 package require tcltest 2.1
@@ -21,10 +21,10 @@ regsub -all ,      $msg "" options
 regsub \"-foo\" $options "" options
 
 foreach option $options {
-    if {[string index $option 0] == "-"} {
-	test clrpick-1.2 {tk_chooseColor command} {
-	    list [catch {tk_chooseColor $option} msg] $msg
-	} [list 1 "value for \"$option\" missing"]
+    if {[string index $option 0] eq "-"} {
+	test clrpick-1.2$option {tk_chooseColor command} -body {
+	    tk_chooseColor $option
+	} -returnCodes error -result "value for \"$option\" missing"
     }
 }
 
@@ -48,11 +48,7 @@ test clrpick-1.7 {tk_chooseColor command} {
     list [catch {tk_chooseColor -initialcolor ##badbadbaadcolor} msg] $msg
 } {1 {invalid color name "##badbadbaadcolor"}}
 
-if {[info commands tk::dialog::color::] == ""} {
-    set isNative 1
-} else {
-    set isNative 0
-}
+set isNative [expr {[info commands tk::dialog::color::] eq ""}]
 
 proc ToPressButton {parent btn} {
     global isNative
diff --git a/tests/cmds.test b/tests/cmds.test
index 7e1680c..0d989a1 100644
--- a/tests/cmds.test
+++ b/tests/cmds.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: cmds.test,v 1.5 2003/04/01 21:06:20 dgp Exp $
+# RCS: @(#) $Id: cmds.test,v 1.6 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -42,16 +42,3 @@ test cmds-1.5 {tkwait visibility, window gets deleted} {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/cursor.test b/tests/cursor.test
index 9da3539..b5ce675 100644
--- a/tests/cursor.test
+++ b/tests/cursor.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: cursor.test,v 1.11 2004/03/17 18:15:49 das Exp $
+# RCS: @(#) $Id: cursor.test,v 1.12 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -131,133 +131,127 @@ test cursor-4.1 {FreeCursorObjProc} {testcursor} {
 
 # -------------------------------------------------------------------------
 
-test cursor-5.1 {assert consistent cursor configuration command} \
-    -setup { button .b } \
-    -body {
-        list [catch {.b configure -cursor {watch red black}} msg] $msg
-    } \
-    -cleanup {destroy .b} \
-    -result {0 {}}
+test cursor-5.1 {assert consistent cursor configuration command} -setup {
+    button .b
+} -body {
+    .b configure -cursor {watch red black}
+} -cleanup {
+    destroy .b
+} -result {}
 
 # -------------------------------------------------------------------------
 # Check for the standard set of cursors.
 
-set n 0
-foreach cursor {
-    X_cursor
-    arrow
-    based_arrow_down
-    based_arrow_up
-    boat
-    bogosity
-    bottom_left_corner
-    bottom_right_corner
-    bottom_side
-    bottom_tee
-    box_spiral
-    center_ptr
-    circle
-    clock
-    coffee_mug
-    cross
-    cross_reverse
-    crosshair
-    diamond_cross
-    dot
-    dotbox
-    double_arrow
-    draft_large
-    draft_small
-    draped_box
-    exchange
-    fleur
-    gobbler
-    gumby
-    hand1
-    hand2
-    heart
-    icon
-    iron_cross
-    left_ptr
-    left_side
-    left_tee
-    leftbutton
-    ll_angle
-    lr_angle
-    man
-    middlebutton
-    mouse
-    pencil
-    pirate
-    plus
-    question_arrow
-    right_ptr
-    right_side
-    right_tee
-    rightbutton
-    rtl_logo
-    sailboat
-    sb_down_arrow
-    sb_h_double_arrow
-    sb_left_arrow
-    sb_right_arrow
-    sb_up_arrow
-    sb_v_double_arrow
-    shuttle
-    sizing
-    spider
-    spraycan
-    star
-    target
-    tcross
-    top_left_arrow
-    top_left_corner
-    top_right_corner
-    top_side
-    top_tee
-    trek
-    ul_angle
-    umbrella
-    ur_angle
-    watch
-    xterm
+foreach {testName cursor} {
+    cursor-6.1  X_cursor
+    cursor-6.2  arrow
+    cursor-6.3  based_arrow_down
+    cursor-6.4  based_arrow_up
+    cursor-6.5  boat
+    cursor-6.6  bogosity
+    cursor-6.7  bottom_left_corner
+    cursor-6.8  bottom_right_corner
+    cursor-6.9  bottom_side
+    cursor-6.10 bottom_tee
+    cursor-6.11 box_spiral
+    cursor-6.12 center_ptr
+    cursor-6.13 circle
+    cursor-6.14 clock
+    cursor-6.15 coffee_mug
+    cursor-6.16 cross
+    cursor-6.17 cross_reverse
+    cursor-6.18 crosshair
+    cursor-6.19 diamond_cross
+    cursor-6.20 dot
+    cursor-6.21 dotbox
+    cursor-6.22 double_arrow
+    cursor-6.23 draft_large
+    cursor-6.24 draft_small
+    cursor-6.25 draped_box
+    cursor-6.26 exchange
+    cursor-6.27 fleur
+    cursor-6.28 gobbler
+    cursor-6.29 gumby
+    cursor-6.30 hand1
+    cursor-6.31 hand2
+    cursor-6.32 heart
+    cursor-6.33 icon
+    cursor-6.34 iron_cross
+    cursor-6.35 left_ptr
+    cursor-6.36 left_side
+    cursor-6.37 left_tee
+    cursor-6.38 leftbutton
+    cursor-6.39 ll_angle
+    cursor-6.40 lr_angle
+    cursor-6.41 man
+    cursor-6.42 middlebutton
+    cursor-6.43 mouse
+    cursor-6.44 pencil
+    cursor-6.45 pirate
+    cursor-6.46 plus
+    cursor-6.47 question_arrow
+    cursor-6.48 right_ptr
+    cursor-6.49 right_side
+    cursor-6.50 right_tee
+    cursor-6.51 rightbutton
+    cursor-6.52 rtl_logo
+    cursor-6.53 sailboat
+    cursor-6.54 sb_down_arrow
+    cursor-6.55 sb_h_double_arrow
+    cursor-6.56 sb_left_arrow
+    cursor-6.57 sb_right_arrow
+    cursor-6.58 sb_up_arrow
+    cursor-6.59 sb_v_double_arrow
+    cursor-6.60 shuttle
+    cursor-6.61 sizing
+    cursor-6.62 spider
+    cursor-6.63 spraycan
+    cursor-6.64 star
+    cursor-6.65 target
+    cursor-6.66 tcross
+    cursor-6.67 top_left_arrow
+    cursor-6.68 top_left_corner
+    cursor-6.68 top_right_corner
+    cursor-6.69 top_side
+    cursor-6.70 top_tee
+    cursor-6.71 trek
+    cursor-6.72 ul_angle
+    cursor-6.73 umbrella
+    cursor-6.74 ur_angle
+    cursor-6.75 watch
+    cursor-6.76 xterm
 } {
-    test cursor-6.$n {check cursor $cursor} \
-        -setup {button .b -text $cursor} \
-        -body {
-            list [catch {.b configure -cursor $cursor} msg] $msg
-        } \
-        -cleanup {destroy .b} \
-        -result {0 {}}
-    incr n
+    test $testName "check cursor-font cursor $cursor" -setup {
+	button .b -text $cursor
+    } -body {
+	.b configure -cursor $cursor
+    } -cleanup {
+	destroy .b
+    } -result {}
 }
-unset n
 
 # -------------------------------------------------------------------------
 # Check the Windows specific cursors
-set n 0
-foreach cursor {
-    no
-    starting
-    size
-    size_ne_sw
-    size_ns
-    size_nw_se
-    size_we
-    uparrow
-    wait
+
+foreach {testName cursor} {
+    cursor-7.1 no
+    cursor-7.2 starting
+    cursor-7.3 size
+    cursor-7.4 size_ne_sw
+    cursor-7.5 size_ns
+    cursor-7.6 size_nw_se
+    cursor-7.7 size_we
+    cursor-7.8 uparrow
+    cursor-7.9 wait
 } {
-    test cursor-7.$n {check cursor $cursor} \
-        -constraints {pcOnly} \
-        -setup {button .b -text $cursor} \
-        -body {
-            list [catch {.b configure -cursor $cursor} msg] $msg
-        } \
-        -cleanup {destroy .b} \
-        -result {0 {}}
-    incr n
+    test testName "check Windows cursor $cursor" -constraints pcOnly -setup {
+	button .b -text $cursor
+    } -body {
+	.b configure -cursor $cursor
+    } -cleanup {
+	destroy .b
+    } -result {}
 }
-unset n
 
 # -------------------------------------------------------------------------
 
diff --git a/tests/entry.test b/tests/entry.test
index a8742b6..8a5713e 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: entry.test,v 1.16 2004/03/17 18:15:49 das Exp $
+# RCS: @(#) $Id: entry.test,v 1.17 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -81,16 +81,16 @@ foreach test {
     {-width 402 402 3p {expected integer but got "3p"}}
     {-xscrollcommand {Some command} {Some command} {} {}}
 } {
-    set name [lindex $test 0]
+    lassign $test name goodValue goodResult badValue badResult
     test entry-1.$i {configuration options} {
-	.e configure $name [lindex $test 1]
+	.e configure $name $goodValue
 	list [lindex [.e configure $name] 4] [.e cget $name]
-    } [list [lindex $test 2] [lindex $test 2]]
+    } [list $goodResult $goodResult]
     incr i
-    if {[lindex $test 3] != ""} {
-	test entry-1.$i {configuration options} {
-	    list [catch {.e configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    if {$badValue ne ""} {
+	test entry-1.$i {configuration options} -body {
+	    .e configure $name $badValue
+	} -returnCodes error -result $badResult
     }
     .e configure $name [lindex [.e configure $name] 3]
     incr i
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]
     }
 
diff --git a/tests/focus.test b/tests/focus.test
index 37a0263..312c4d4 100644
--- a/tests/focus.test
+++ b/tests/focus.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: focus.test,v 1.9 2003/04/01 21:06:25 dgp Exp $
+# RCS: @(#) $Id: focus.test,v 1.10 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -642,16 +642,3 @@ bind all <FocusOut> {}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/focusTcl.test b/tests/focusTcl.test
index 1570c36..4a891b5 100644
--- a/tests/focusTcl.test
+++ b/tests/focusTcl.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: focusTcl.test,v 1.7 2003/10/28 22:52:16 hobbs Exp $
+# RCS: @(#) $Id: focusTcl.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -278,16 +278,3 @@ option clear
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/font.test b/tests/font.test
index ed6a64a..cc0aa45 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: font.test,v 1.10 2004/03/17 18:15:49 das Exp $
+# RCS: @(#) $Id: font.test,v 1.11 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -672,54 +672,70 @@ test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
 } {NewCenturySchlbk-Roman}
 set i 10
 foreach p {
-    {"avantgarde" AvantGarde-Book AvantGarde-Demi AvantGarde-BookOblique AvantGarde-DemiOblique}
-    {"bookman" Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
-    {"courier" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
-    {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
-    {"new century schoolbook" NewCenturySchlbk-Roman NewCenturySchlbk-Bold NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
-    {"palatino" Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
-    {"symbol" Symbol Symbol Symbol Symbol}
-    {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
-    {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
-    {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
+    {font-21.10 "avantgarde"
+	    AvantGarde-Book AvantGarde-Demi
+	    AvantGarde-BookOblique AvantGarde-DemiOblique}
+    {font-21.11 "bookman"
+	    Bookman-Light Bookman-Demi Bookman-LightItalic Bookman-DemiItalic}
+    {font-21.12 "courier"
+	    Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
+    {font-21.13 "helvetica"
+	    Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+    {font-21.14 "new century schoolbook"
+	    NewCenturySchlbk-Roman NewCenturySchlbk-Bold
+	    NewCenturySchlbk-Italic NewCenturySchlbk-BoldItalic}
+    {font-21.15 "palatino"
+	    Palatino-Roman Palatino-Bold Palatino-Italic Palatino-BoldItalic}
+    {font-21.16 "symbol"
+	    Symbol Symbol Symbol Symbol}
+    {font-21.17 "times"
+	    Times-Roman Times-Bold Times-Italic Times-BoldItalic}
+    {font-21.18 "zapfchancery"
+	    ZapfChancery-MediumItalic ZapfChancery-MediumItalic
+	    ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
+    {font-21.19 "zapfdingbats"
+	    ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
 } {
-    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
-	set family [lindex $p 0]
+    set values [lassign $p testName family]
+    test $testName {Tk_PostscriptFontName procedure: exhaustive} unixOnly {
 	set x {}
-	set i 1
+	set j 0
 	foreach slant {roman italic} {
 	    foreach weight {normal bold} {
 		set name [list $family 12 $slant $weight]
 		if {[font actual $name -family] == $family} {
 		    lappend x [psfontname $name]
 		} else {
-		    lappend x [lindex $p $i]
+		    lappend x [lindex $values $j]
 		}
-		incr i
+		incr j
 	    }
 	}
-        incr i
 	set x
-    } [lrange $p 1 end]
+    } $values
 }
 foreach p {
-    {"arial" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
-    {"courier new" Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
-    {"helvetica" Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
-    {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
-    {"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
+    {font-21.20 "arial"
+	    Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+    {font-21.21 "courier new"
+	    Courier Courier-Bold Courier-Oblique Courier-BoldOblique}
+    {font-21.22 "helvetica"
+	    Helvetica Helvetica-Bold Helvetica-Oblique Helvetica-BoldOblique}
+    {font-21.23 "symbol"
+	    Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
+    {font-21.24 "times new roman"
+	    Times-Roman Times-Bold Times-Italic Times-BoldItalic}
 } {
-    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
-	set family [lindex $p 0]
+    set values [lassign $p testName family]
+    test $testName {Tk_PostscriptFontName procedure: exhaustive} pcOnly {
 	set x {}
 	foreach slant {roman italic} {
 	    foreach weight {normal bold} {
 		lappend x [psfontname [list $family 12 "$slant $weight"]]
 	    }
 	}
-        incr i
 	set x
-    } [lrange $p 1 end]
+    } $values
 }
 
 test font-22.1 {Tk_TextWidth procedure} {
@@ -1115,48 +1131,47 @@ test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
 test font-33.1 {Tk_TextWidth procedure} {
 } {}
 
-test font-33.2 {ConfigAttributesObj procedure: arguments} {
+test font-34.1 {ConfigAttributesObj procedure: arguments} {
     # (Tcl_GetIndexFromObj() != TCL_OK)
     setup
     list [catch {font create xyz -xyz} msg] $msg
 } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-34.1 {ConfigAttributesObj procedure: arguments} {
+test font-34.2 {ConfigAttributesObj procedure: arguments} {
     # (objc & 1)
     setup
     list [catch {font create xyz -family} msg] $msg
 } {1 {value for "-family" option missing}}
-set i 3
 foreach p {
-    {family xyz times}
-    {size 20 40}
-    {weight normal bold}
-    {slant roman italic}
-    {underline 0 1}
-    {overstrike 0 1}
+    {font-34.3 family xyz times}
+    {font-34.4 size 20 40}
+    {font-34.5 weight normal bold}
+    {font-34.6 slant roman italic}
+    {font-34.7 underline 0 1}
+    {font-34.8 overstrike 0 1}
 } {
-    set opt [lindex $p 0]
-    test font-34.$i "ConfigAttributesObj procedure: $opt" {
+    lassign $p testName opt val1 val2
+    test $testName "ConfigAttributesObj procedure: $opt" {
 	setup
 	set x {}
-	font create xyz -$opt [lindex $p 1]
+	font create xyz -$opt $val1
 	lappend x [font config xyz -$opt]
-	font config xyz -$opt [lindex $p 2]
+	font config xyz -$opt $val2
 	lappend x [font config xyz -$opt]
-    } [lrange $p 1 2]
-    incr i
+    } [list $val1 $val2]
 }
 foreach p {
-    {size	xyz {1 {expected integer but got "xyz"}}}
-    {weight	xyz {1 {bad -weight value "xyz": must be normal, or bold}}}
-    {slant	xyz {1 {bad -slant value "xyz": must be roman, or italic}}}
-    {underline	xyz {1 {expected boolean value but got "xyz"}}}
-    {overstrike	xyz {1 {expected boolean value but got "xyz"}}}
+    {font-34.9  size   xyz {expected integer but got "xyz"}}
+    {font-34.10 weight xyz {bad -weight value "xyz": must be normal, or bold}}
+    {font-34.11 slant  xyz {bad -slant value "xyz": must be roman, or italic}}
+    {font-34.12 underline  xyz {expected boolean value but got "xyz"}}
+    {font-34.13 overstrike xyz {expected boolean value but got "xyz"}}
 } {
-    test font-34.$i "ConfigAttributesObj procedure: [lindex $p 0]" {
+    lassign $p testName opt val result
+    test $testName "ConfigAttributesObj procedure: $opt" -setup {
 	setup
-	list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg
-    } [lindex $p 2]
-    incr i
+    } -body {
+	font create xyz -$opt $val
+    } -returnCodes error -result $result
 }
 
 test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
@@ -1165,12 +1180,14 @@ test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
     font create xyz -family xyz
     font config xyz -family
 } {xyz}
+
 test font-36.1 {GetAttributeInfoObj procedure: unknown attribute} {
     # (Tcl_GetIndexFromObj() != TCL_OK)
     setup
     font create xyz
     list [catch {font config xyz -xyz} msg] $msg
 } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+
 test font-37.1 {GetAttributeInfoObj procedure: all attributes} {
     # not (objPtr != NULL) 
     setup
@@ -1179,19 +1196,20 @@ test font-37.1 {GetAttributeInfoObj procedure: all attributes} {
 } {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
 set i 4
 foreach p {
-    {family	xyz	xyz}
-    {size	20	20}
-    {weight	normal	normal}
-    {slant	italic	italic}
-    {underline	yes	1}
-    {overstrike	false	0}
+    {font-37.2 family     xyz    xyz}
+    {font-37.3 size       20     20}
+    {font-37.4 weight     normal normal}
+    {font-37.5 slant      italic italic}
+    {font-37.6 underline  yes    1}
+    {font-37.7 overstrike false  0}
 } {
-    test font-31.$i "GetAttributeInfo procedure: [lindex $p 0]" {
+    lassign $p testName opt val expected
+    test $testName "GetAttributeInfo procedure: $opt" -setup {
 	setup
-	font create xyz -[lindex $p 0] [lindex $p 1]
-	font config xyz -[lindex $p 0]
-    } [lindex $p 2]
-    incr i
+    } -body {
+	font create xyz -$opt $val
+	font config xyz -$opt
+    } -result $expected
 }
 
 # In tests below, one field is set to "xyz" so that font name doesn't
@@ -1319,16 +1337,3 @@ destroy .b
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/frame.test b/tests/frame.test
index 22f4091..41307fe 100644
--- a/tests/frame.test
+++ b/tests/frame.test
@@ -7,12 +7,20 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: frame.test,v 1.9 2003/07/16 23:16:52 pspjuth Exp $
+# RCS: @(#) $Id: frame.test,v 1.10 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
+testConstraint haveDISPLAY [info exists env(DISPLAY)]
+testConstraint edibleColors [expr {
+    ([winfo visual .] == "pseudocolor") && ([winfo depth .] == 8)
+}]
+testConstraint haveGrayscale8 [expr {
+    [lsearch -exact [winfo visualsavailable .] {grayscale 8}] >= 0
+}]
+
 # eatColors --
 # Creates a toplevel window and allocates enough colors in it to
 # use up all the slots in the colormap.
@@ -120,23 +128,22 @@ foreach test {
     {-takefocus "any string" "any string" {} {}}
     {-width 32 32 badValue {bad screen distance "badValue"}}
 } {
-    set name [lindex $test 0]
+    lassign $test opt goodValue goodResult badValue badResult
     test frame-1.$i {frame configuration options} {
-	.f configure $name [lindex $test 1]
-	lindex [.f configure $name] 4
-    } [lindex $test 2]
+	.f configure $opt $goodValue
+	lindex [.f configure $opt] 4
+    } $goodResult
     incr i
-    if {[lindex $test 3] != ""} {
-	test frame-1.$i {frame configuration options} {
-	    list [catch {.f configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    if {$badValue ne ""} {
+	test frame-1.$i {frame configuration options} -body {
+	    .f configure $opt $badValue
+	} -returnCodes error -result $badResult
     }
-    .f configure $name [lindex [.f configure $name] 3]
+    .f configure $opt [lindex [.f configure $opt] 3]
     incr i
 }
 destroy .f
 
-set i 1
 test frame-2.1 {toplevel configuration options} {
     catch {destroy .t}
     toplevel .t -width 200 -height 100 -class NewClass
@@ -176,15 +183,13 @@ test frame-2.7 {toplevel configuration options} {
     catch {destroy .t}
     list [catch {toplevel .t -width 200 -height 100 -visual who_knows?} msg] $msg
 } {1 {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
-if [info exists env(DISPLAY)] {
-    test frame-2.8 {toplevel configuration options} {
-	catch {destroy .t}
-	toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
-	wm geometry .t +0+0
-	list [.t configure -screen] \
-		[catch {.t configure -screen another} msg] $msg
-    } [list [list -screen screen Screen {} $env(DISPLAY)] 1 {can't modify -screen option after widget is created}]
-}
+test frame-2.8 {toplevel configuration options} haveDISPLAY {
+    catch {destroy .t}
+    toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
+    wm geometry .t +0+0
+    list [.t configure -screen] \
+	    [catch {.t configure -screen another} msg] $msg
+} [list [list -screen screen Screen {} $env(DISPLAY)] 1 {can't modify -screen option after widget is created}]
 test frame-2.9 {toplevel configuration options} {
     catch {destroy .t}
     list [catch {toplevel .t -width 200 -height 100 -screen bogus} msg] $msg
@@ -234,38 +239,40 @@ foreach test {
     {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
     {-width 32 32 badValue {bad screen distance "badValue"}}
 } {
-    set name [lindex $test 0]
+    lassign $test opt goodValue goodResult badValue badResult
     test frame-2.$i {toplevel configuration options} {
-	.t configure $name [lindex $test 1]
-	lindex [.t configure $name] 4
-    } [lindex $test 2]
+	.t configure $opt $goodValue
+	lindex [.t configure $opt] 4
+    } $goodResult
     incr i
-    if {[lindex $test 3] != ""} {
-	test frame-2.$i {toplevel configuration options} {
-	    list [catch {.t configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    if {$badValue ne ""} {
+	test frame-2.$i {toplevel configuration options} -body {
+	    .t configure $opt $badValue
+	} -returnCodes error -result $badResult
     }
-    .t configure $name [lindex [.t configure $name] 3]
+    .t configure $opt [lindex [.t configure $opt] 3]
     incr i
 }
 
-test frame-3.1 {TkCreateFrame procedure} {
-    list [catch frame msg] $msg
-} {1 {wrong # args: should be "frame pathName ?options?"}}
-test frame-3.2 {TkCreateFrame procedure} {
+test frame-3.1 {TkCreateFrame procedure} -body {
+    frame
+} -returnCodes error -result {wrong # args: should be "frame pathName ?options?"}
+test frame-3.2 {TkCreateFrame procedure} -setup {
     catch {destroy .f}
     frame .f
-    set result [.f configure -class]
+} -body {
+    .f configure -class
+} -cleanup {
     destroy .f
-    set result
-} {-class class Class Frame Frame}
-test frame-3.3 {TkCreateFrame procedure} {
+} -result {-class class Class Frame Frame}
+test frame-3.3 {TkCreateFrame procedure} -setup {
     catch {destroy .t}
     toplevel .t
     wm geometry .t +0+0
-    set result [.t configure -class]
+} -body {
+    .t configure -class
+} -cleanup {
     destroy .t
-    set result
 } {-class class Class Toplevel Toplevel}
 test frame-3.4 {TkCreateFrame procedure} {
     catch {destroy .t}
@@ -310,141 +317,147 @@ test frame-3.8 {TkCreateFrame procedure} {
     option clear
     list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
 } {Silly #122334}
-test frame-3.9 {TkCreateFrame procedure, -use option} unixOnly {
+test frame-3.9 {TkCreateFrame procedure, -use option} -setup {
     catch {destroy .t}
     catch {destroy .x}
+} -constraints unixOnly -body {
     toplevel .t -container 1 -width 300 -height 120
     wm geometry .t +0+0
     toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green
     tkwait visibility .x
-    set result "[expr [winfo rootx .x] - [winfo rootx .t]] [expr [winfo rooty .x] - [winfo rooty .t]] [winfo width .t] [winfo height .t]"
+    list [expr {[winfo rootx .x] - [winfo rootx .t]}] \
+	    [expr {[winfo rooty .x] - [winfo rooty .t]}] \
+	    [winfo width .t] [winfo height .t]
+} -cleanup {
     destroy .t
-    set result
-} {0 0 140 300}
-test frame-3.10 {TkCreateFrame procedure, -use option} unixOnly {
+} -result {0 0 140 300}
+test frame-3.10 {TkCreateFrame procedure, -use option} -setup {
     catch {destroy .t}
     catch {destroy .x}
+} -constraints unixOnly -body {
     toplevel .t -container 1 -width 300 -height 120
     wm geometry .t +0+0
     option add *x.use [winfo id .t]
     toplevel .x -width 140 -height 300 -bg green
     tkwait visibility .x
-    set result "[expr [winfo rootx .x] - [winfo rootx .t]] [expr [winfo rooty .x] - [winfo rooty .t]] [winfo width .t] [winfo height .t]"
-     destroy .t
+    list [expr {[winfo rootx .x] - [winfo rootx .t]}] \
+	    [expr {[winfo rooty .x] - [winfo rooty .t]}] \
+	    [winfo width .t] [winfo height .t]
+} -cleanup {
+    destroy .t
     option clear
-    set result
-} {0 0 140 300}
+} -result {0 0 140 300}
 
 # The tests below require specific display characteristics.  Even so,
 # they are non-portable:  some machines don't seem to ever run out of
 # colors.
 
-if {([winfo visual .] == "pseudocolor") && ([winfo depth .] == 8)} {
+if {[testConstraint edibleColors]} {
     eatColors .t1
-    test frame-3.11 {TkCreateFrame procedure} {nonPortable} {
-	catch {destroy .t}
-	toplevel .t -width 300 -height 200 -bg #475601
-	wm geometry .t +0+0
-	update
-	colorsFree .t
-    } {0}
-    test frame-3.12 {TkCreateFrame procedure} {nonPortable} {
-	catch {destroy .t}
-	toplevel .t -width 300 -height 200 -bg #475601 -colormap new
-	wm geometry .t +0+0
-	update
-	colorsFree .t
-    } {1}
-    test frame-3.13 {TkCreateFrame procedure} {nonPortable} {
-	catch {destroy .t}
-	option add *t.class Toplevel2
-	option add *Toplevel2.colormap new
-	toplevel .t -width 300 -height 200 -bg #475601
-	wm geometry .t +0+0
-	update
-	option clear
-	colorsFree .t
-    } {1}
-    test frame-3.14 {TkCreateFrame procedure} {nonPortable} {
-	catch {destroy .t}
-	option add *t.class Toplevel3
-	option add *Toplevel3.Colormap new
-	toplevel .t -width 300 -height 200 -bg #475601 -colormap new
-	wm geometry .t +0+0
-	update
-	option clear
-	colorsFree .t
-    } {1}
-    test frame-3.15 {TkCreateFrame procedure, -use and -colormap} {unixOnly nonPortable} {
-	catch {destroy .t}
-	catch {destroy .x}
-	toplevel .t -container 1 -width 300 -height 120
-	wm geometry .t +0+0
-	toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new
-	tkwait visibility .x
-	set result "[colorsFree .t] [colorsFree .x]"
-	destroy .t
-	set result
-    } {0 1}
-    test frame-3.16 {TkCreateFrame procedure} {nonPortable} {
-	catch {destroy .t}
-	toplevel .t -width 300 -height 200 -bg #475601 -visual default
-	wm geometry .t +0+0
-	update
-	colorsFree .t
-    } {0}
-    test frame-3.17 {TkCreateFrame procedure} {nonPortable} {
-	catch {destroy .t}
-	toplevel .t -width 300 -height 200 -bg #475601 -visual default \
-		-colormap new
-	wm geometry .t +0+0
-	update
-	colorsFree .t
-    } {1}
-    if {[lsearch -exact [winfo visualsavailable .] {grayscale 8}] >= 0} {
-        test frame-3.18 {TkCreateFrame procedure} {nonPortable} {
-	    catch {destroy .t}
-	    toplevel .t -visual {grayscale 8} -width 300 -height 200 \
-		    -bg #434343 
-	    wm geometry .t +0+0
-	    update
-	    colorsFree .t 131 131 131
-	} {1}
-        test frame-3.19 {TkCreateFrame procedure} {nonPortable} {
-	    catch {destroy .t}
-	    option add *t.class T4
-	    option add *T4.visual {grayscale 8}
-	    toplevel .t -width 300 -height 200 -bg #434343
-	    wm geometry .t +0+0
-	    update
-	    option clear
-	    list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
-	} {1 {grayscale 8}}
-        test frame-3.20 {TkCreateFrame procedure} {nonPortable} {
-	    catch {destroy .t}
-	    set x ok
-	    option add *t.class T5
-	    option add *T5.Visual {grayscale 8}
-	    toplevel .t -width 300 -height 200 -bg #434343
-	    wm geometry .t +0+0
-	    update
-	    option clear
-	    list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
-	} {1 {grayscale 8}}
-        test frame-3.21 {TkCreateFrame procedure} {nonPortable} {
-	    catch {destroy .t}
-	    set x ok
-	    toplevel .t -visual {grayscale 8} -width 300 -height 200 \
-		    -bg #434343 
-	    wm geometry .t +0+0
-	    update
-	    colorsFree .t 131 131 131
-	} {1}
-    }
+}
+test frame-3.11 {TkCreateFrame procedure} {edibleColors nonPortable} {
+    catch {destroy .t}
+    toplevel .t -width 300 -height 200 -bg #475601
+    wm geometry .t +0+0
+    update
+    colorsFree .t
+} {0}
+test frame-3.12 {TkCreateFrame procedure} {edibleColors nonPortable} {
+    catch {destroy .t}
+    toplevel .t -width 300 -height 200 -bg #475601 -colormap new
+    wm geometry .t +0+0
+    update
+    colorsFree .t
+} {1}
+test frame-3.13 {TkCreateFrame procedure} {edibleColors nonPortable} {
+    catch {destroy .t}
+    option add *t.class Toplevel2
+    option add *Toplevel2.colormap new
+    toplevel .t -width 300 -height 200 -bg #475601
+    wm geometry .t +0+0
+    update
+    option clear
+    colorsFree .t
+} {1}
+test frame-3.14 {TkCreateFrame procedure} {edibleColors nonPortable} {
+    catch {destroy .t}
+    option add *t.class Toplevel3
+    option add *Toplevel3.Colormap new
+    toplevel .t -width 300 -height 200 -bg #475601 -colormap new
+    wm geometry .t +0+0
+    update
+    option clear
+    colorsFree .t
+} {1}
+test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -setup {
+    catch {destroy .t}
+    catch {destroy .x}
+} -constraints {edibleColors unixOnly nonPortable} -body {
+    toplevel .t -container 1 -width 300 -height 120
+    wm geometry .t +0+0
+    toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new
+    tkwait visibility .x
+    list [colorsFree .t] [colorsFree .x]
+} -cleanup {
+    destroy .t
+} -result {0 1}
+test frame-3.16 {TkCreateFrame procedure} {edibleColors nonPortable} {
+    catch {destroy .t}
+    toplevel .t -width 300 -height 200 -bg #475601 -visual default
+    wm geometry .t +0+0
+    update
+    colorsFree .t
+} {0}
+test frame-3.17 {TkCreateFrame procedure} {edibleColors nonPortable} {
+    catch {destroy .t}
+    toplevel .t -width 300 -height 200 -bg #475601 -visual default \
+	    -colormap new
+    wm geometry .t +0+0
+    update
+    colorsFree .t
+} {1}
+test frame-3.18 {TkCreateFrame procedure} {edibleColors haveGrayscale8 nonPortable} {
+    catch {destroy .t}
+    toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 
+    wm geometry .t +0+0
+    update
+    colorsFree .t 131 131 131
+} {1}
+test frame-3.19 {TkCreateFrame procedure} {edibleColors haveGrayscale8 nonPortable} {
+    catch {destroy .t}
+    option add *t.class T4
+    option add *T4.visual {grayscale 8}
+    toplevel .t -width 300 -height 200 -bg #434343
+    wm geometry .t +0+0
+    update
+    option clear
+    list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
+} {1 {grayscale 8}}
+test frame-3.20 {TkCreateFrame procedure} {edibleColors haveGrayscale8 nonPortable} {
+    catch {destroy .t}
+    set x ok
+    option add *t.class T5
+    option add *T5.Visual {grayscale 8}
+    toplevel .t -width 300 -height 200 -bg #434343
+    wm geometry .t +0+0
+    update
+    option clear
+    list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
+} {1 {grayscale 8}}
+test frame-3.21 {TkCreateFrame procedure} {edibleColors haveGrayscale8 nonPortable} {
+    catch {destroy .t}
+    set x ok
+    toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343 
+    wm geometry .t +0+0
+    update
+    colorsFree .t 131 131 131
+} {1}
+if {[testConstraint edibleColors]} {
     destroy .t1
 }
-test frame-3.22 {TkCreateFrame procedure, default dimensions} {
+test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup {
     catch {destroy .t}
+} -body {
     toplevel .t
     wm geometry .t +0+0
     update
@@ -453,20 +466,20 @@ test frame-3.22 {TkCreateFrame procedure, default dimensions} {
     pack .t.f
     update
     lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
+} -cleanup {
     destroy .t
-    set result
-} {200 200 1 1}
-test frame-3.23 {TkCreateFrame procedure} {
+} -result {200 200 1 1}
+test frame-3.23 {TkCreateFrame procedure} -setup {
     catch {destroy .f}
-    list [catch {frame .f -gorp glob} msg] $msg
-} {1 {unknown option "-gorp"}}
-test frame-3.24 {TkCreateFrame procedure} {
+} -body {
+    frame .f -gorp glob
+} -returnCodes error -result {unknown option "-gorp"}
+test frame-3.24 {TkCreateFrame procedure} -setup {
     catch {destroy .t}
-    list [catch {
-	toplevel .t -width 300 -height 200 -colormap new -bogus option
-	wm geometry .t +0+0
-    } msg] $msg
-} {1 {unknown option "-bogus"}}
+} -body {
+    toplevel .t -width 300 -height 200 -colormap new -bogus option
+    wm geometry .t +0+0
+} -returnCodes error -result {unknown option "-bogus"}
 
 test frame-4.1 {TkCreateFrame procedure} {
     catch {destroy .f}
@@ -776,16 +789,16 @@ foreach test {
     {-text "any string" "any string" {} {}}
     {-width 32 32 badValue {bad screen distance "badValue"}}
 } {
-    set name [lindex $test 0]
+    lassign $test name goodValue goodResult badValue badResult
     test frame-13.$i {labelframe configuration options} {
-	.f configure $name [lindex $test 1]
+	.f configure $name $goodValue
 	lindex [.f configure $name] 4
-    } [lindex $test 2]
+    } $goodResult
     incr i
-    if {[lindex $test 3] != ""} {
-	test frame-13.$i {labelframe configuration options} {
-	    list [catch {.f configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    if {$badValue ne ""} {
+	test frame-13.$i {labelframe configuration options} -body {
+	    .f configure $name $badValue
+	} -returnCodes error -result $badResult
     }
     .f configure $name [lindex [.f configure $name] 3]
     incr i
diff --git a/tests/geometry.test b/tests/geometry.test
index 77a2a93..d005891 100644
--- a/tests/geometry.test
+++ b/tests/geometry.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: geometry.test,v 1.5 2003/04/01 21:06:34 dgp Exp $
+# RCS: @(#) $Id: geometry.test,v 1.6 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -249,16 +249,3 @@ catch {destroy .t}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/get.test b/tests/get.test
index c9c2e38..66c5d1e 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: get.test,v 1.4 2003/04/01 21:06:35 dgp Exp $
+# RCS: @(#) $Id: get.test,v 1.5 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -78,16 +78,3 @@ test get-2.4 {Tk_GetJustifyFromObj - error} {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/id.test b/tests/id.test
index acc0712..b1933db 100644
--- a/tests/id.test
+++ b/tests/id.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: id.test,v 1.7 2003/04/01 21:06:36 dgp Exp $
+# RCS: @(#) $Id: id.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -91,16 +91,3 @@ bind all <Destroy> {}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/imgBmap.test b/tests/imgBmap.test
index ebdaf07..8849f73 100644
--- a/tests/imgBmap.test
+++ b/tests/imgBmap.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: imgBmap.test,v 1.5 2003/04/01 21:06:37 dgp Exp $
+# RCS: @(#) $Id: imgBmap.test,v 1.6 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -469,16 +469,3 @@ eval image delete [image names]
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/imgPPM.test b/tests/imgPPM.test
index 20f224b..1e043bd 100644
--- a/tests/imgPPM.test
+++ b/tests/imgPPM.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: imgPPM.test,v 1.6 2003/04/01 21:06:37 dgp Exp $
+# RCS: @(#) $Id: imgPPM.test,v 1.7 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -151,16 +151,3 @@ eval image delete [image names]
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 9374b0f..05f8297 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -9,7 +9,7 @@
 #
 # Author: Paul Mackerras (paulus@cs.anu.edu.au)
 #
-# RCS: @(#) $Id: imgPhoto.test,v 1.18 2004/02/17 20:39:52 dgp Exp $
+# RCS: @(#) $Id: imgPhoto.test,v 1.19 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -34,7 +34,7 @@ if {![file exists $teapotPhotoFile]} {
     set newLib [file dirname [testsDirectory]]
     set teapotPhotoFile [file join $newLib library demos images teapot.ppm]
     if {![file exists $teapotPhotoFile]} {
-	testConstraint hasTeapotPhoto
+	testConstraint hasTeapotPhoto 0
     }
 }
 
diff --git a/tests/main.test b/tests/main.test
index ff86dc2..ffb098a 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -8,7 +8,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: main.test,v 1.8 2003/09/05 22:44:39 dgp Exp $
+# RCS: @(#) $Id: main.test,v 1.9 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -102,16 +102,3 @@ test main-2.3 {Tk_MainEx: -encoding option} -constraints {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/menu.test b/tests/menu.test
index d5d93d0..1441eab 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: menu.test,v 1.15 2003/05/30 11:03:02 vincentdarley Exp $
+# RCS: @(#) $Id: menu.test,v 1.16 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -2041,23 +2041,23 @@ test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} {
     catch {destroy .m2}
     menu .m1
     list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
- } {0 {} {}}
- test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
+} {0 {} {}}
+test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
     menu .m1
     .m1 clone .m2
     list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
- } {0 {} {}}
- test menu-20.8 {CloneMenu - cascade entries} {
+} {0 {} {}}
+test menu-20.8 {CloneMenu - cascade entries} {
     catch {destroy .m1}
     catch {destroy .foo}
     menu .m1
     .m1 add cascade -menu .m2
     list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
- } {0 {} {}}
- test menu-20.9 {CloneMenu - cascades entries} {
+} {0 {} {}}
+test menu-20.9 {CloneMenu - cascades entries} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .foo}
@@ -2065,7 +2065,7 @@ test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} {
     .m1 add cascade -menu .m2
     menu .m2
     list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
- } {0 {} {}}
+} {0 {} {}}
 test menu-20.10 {CloneMenu - tearoff fields} {
     catch {destroy .m1}
     catch {destroy .m2}
diff --git a/tests/menuDraw.test b/tests/menuDraw.test
index 156ee9f..b217948 100644
--- a/tests/menuDraw.test
+++ b/tests/menuDraw.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: menuDraw.test,v 1.7 2004/03/17 18:15:49 das Exp $
+# RCS: @(#) $Id: menuDraw.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -511,16 +511,3 @@ test menuDraw-17.2 {AdjustMenuCoords - menu} {pcOnly userInteraction} {
 deleteWindows
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/menubut.test b/tests/menubut.test
index 93153bc..32039d5 100644
--- a/tests/menubut.test
+++ b/tests/menubut.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: menubut.test,v 1.8 2003/04/01 21:06:45 dgp Exp $
+# RCS: @(#) $Id: menubut.test,v 1.9 2004/05/23 17:34:48 dkf Exp $
 
 # XXX This test file is woefully incomplete right now.  If any part
 # XXX of a procedure has tests then the whole procedure has tests,
@@ -341,16 +341,3 @@ option clear
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/msgbox.test b/tests/msgbox.test
index fb07c80..2959ccd 100644
--- a/tests/msgbox.test
+++ b/tests/msgbox.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: msgbox.test,v 1.7 2003/04/01 21:06:47 dgp Exp $
+# RCS: @(#) $Id: msgbox.test,v 1.8 2004/05/23 17:34:49 dkf Exp $
 #
 
 package require tcltest 2.1
@@ -24,10 +24,10 @@ regsub -all ,      $msg "" options
 regsub \"-foo\" $options "" options
 
 foreach option $options {
-    if {[string index $option 0] == "-"} {
-	test msgbox-1.3 {tk_messageBox command} {
-	    list [catch {tk_messageBox $option} msg] $msg
-	} [list 1 "value for \"$option\" missing"]
+    if {[string index $option 0] eq "-"} {
+	test msgbox-1.3$option {tk_messageBox command} -body {
+	    tk_messageBox $option
+	} -returnCodes error -result "value for \"$option\" missing"
     }
 }
 
@@ -67,11 +67,7 @@ test msgbox-1.10 {tk_messageBox command} {
     list [catch {tk_messageBox -parent foo.bar} msg] $msg
 } {1 {bad window path name "foo.bar"}}
 
-if {[info commands tk::MessageBox] == ""} {
-    set isNative 1
-} else {
-    set isNative 0
-}
+set isNative [expr {[info commands tk::MessageBox] == ""}]
 
 proc ChooseMsg {parent btn} {
     global isNative
@@ -133,35 +129,35 @@ foreach spec $specs {
     set buttons [lindex $spec 3]
 
     set button [lindex $buttons 0]
-    test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} {
+    test msgbox-2.$count {tk_messageBox command} nonUnixUserInteraction {
 	ChooseMsg $parent $button
 	tk_messageBox -title Hi -message "Please press $button" \
-	    -type $type
+		-type $type
     } $button
     incr count
 
     foreach icon {warning error info question} {
 	test msgbox-2.$count {tk_messageBox command -icon option} \
-		{nonUnixUserInteraction} {
+		nonUnixUserInteraction {
 	    ChooseMsg $parent $button
 	    tk_messageBox -title Hi -message "Please press $button" \
-		-type $type -icon $icon
+		    -type $type -icon $icon
 	} $button
         incr count
     }
 
     foreach button $buttons {
-	test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} {
+	test msgbox-2.$count {tk_messageBox command} nonUnixUserInteraction {
 	    ChooseMsg $parent $button
 	    tk_messageBox -title Hi -message "Please press $button" \
-		-type $type -default $button
+		    -type $type -default $button
 	} "$button"
         incr count
     }
 }
 
 # These tests will hang your test suite if they fail.
-test msgbox-3.1 {tk_messageBox handles withdrawn parent} {nonUnixUserInteraction} {
+test msgbox-3.1 {tk_messageBox handles withdrawn parent} nonUnixUserInteraction {
     wm withdraw .
     ChooseMsg . "ok"
     tk_messageBox -title Hi -message "Please press ok" \
@@ -169,13 +165,13 @@ test msgbox-3.1 {tk_messageBox handles withdrawn parent} {nonUnixUserInteraction
 } "ok"
 wm deiconify .
 
-test msgbox-3.2 {tk_messageBox handles iconified parent} {nonUnixUserInteraction} {
+test msgbox-3.2 {tk_messageBox handles iconified parent} nonUnixUserInteraction {
     wm iconify .
     ChooseMsg . "ok"
     tk_messageBox -title Hi -message "Please press ok" \
 	    -type ok -default ok
 } "ok"
-wm deiconify .    
+wm deiconify .
 
 # cleanup
 cleanupTests
diff --git a/tests/obj.test b/tests/obj.test
index 9778b2e..3112f8b 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: obj.test,v 1.4 2003/04/01 21:06:47 dgp Exp $
+# RCS: @(#) $Id: obj.test,v 1.5 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -30,17 +30,3 @@ deleteWindows
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/oldpack.test b/tests/oldpack.test
index 33a2719..f12b32d 100644
--- a/tests/oldpack.test
+++ b/tests/oldpack.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: oldpack.test,v 1.6 2003/04/01 21:06:48 dgp Exp $
+# RCS: @(#) $Id: oldpack.test,v 1.7 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -509,16 +509,3 @@ catch {destroy .pack}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/option.test b/tests/option.test
index 7ddaa96..2cdd675 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -6,12 +6,14 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: option.test,v 1.5 2003/04/01 21:06:48 dgp Exp $
+# RCS: @(#) $Id: option.test,v 1.6 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
+testConstraint appNameIsTktest [expr {[winfo name .] eq "tktest"}]
+
 catch {destroy .op1}
 catch {destroy .op2}
 set appName [winfo name .]
@@ -193,9 +195,7 @@ test option-15.1 {database files} {
 } {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
-if {$appName == "tktest"} {
-    test option-15.3 {database files} {option get . x2 color} green
-}
+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} {}
@@ -227,16 +227,3 @@ catch {destroy .op2}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/panedwindow.test b/tests/panedwindow.test
index 9be6aae..f746719 100644
--- a/tests/panedwindow.test
+++ b/tests/panedwindow.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: panedwindow.test,v 1.13 2004/05/03 19:16:11 hobbs Exp $
+# RCS: @(#) $Id: panedwindow.test,v 1.14 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -40,7 +40,7 @@ foreach test {
 	list [lindex [.p configure $name] 4] [.p cget $name]
     } [list [lindex $test 2] [lindex $test 2]]
     incr i
-    if {[lindex $test 3] != ""} {
+    if {[lindex $test 3] ne ""} {
 	test panedwindow-1.$i {configuration options} {
 	    list [catch {.p configure $name [lindex $test 3]} msg] $msg
 	} [list 1 [lindex $test 4]]
@@ -66,7 +66,7 @@ foreach test {
 	list [lindex [.p paneconfigure .b $name] 4] [.p panecget .b $name]
     } [list [lindex $test 2] [lindex $test 2]]
     incr i
-    if {[lindex $test 3] != ""} {
+    if {[lindex $test 3] ne ""} {
 	test panedwindow-1.$i {configuration options} {
 	    list [catch {.p paneconfigure .b $name [lindex $test 3]} msg] $msg
 	} [list 1 [lindex $test 4]]
diff --git a/tests/raise.test b/tests/raise.test
index bcf3573..21650f2 100644
--- a/tests/raise.test
+++ b/tests/raise.test
@@ -8,7 +8,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: raise.test,v 1.8 2003/04/01 21:06:50 dgp Exp $
+# RCS: @(#) $Id: raise.test,v 1.9 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -289,16 +289,3 @@ deleteWindows
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/scale.test b/tests/scale.test
index 13c1d3a..ffc4101 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: scale.test,v 1.14 2003/08/13 10:28:21 patthoyts Exp $
+# RCS: @(#) $Id: scale.test,v 1.15 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -78,7 +78,7 @@ foreach test {
 	lindex [.s configure $name] 4
     } [lindex $test 2]
     incr i
-    if {[lindex $test 3] != ""} {
+    if {[lindex $test 3] ne ""} {
 	test scale-1.$i {configuration options} {
 	    list [catch {.s configure $name [lindex $test 3]} msg] $msg
 	} [list 1 [lindex $test 4]]
diff --git a/tests/scrollbar.test b/tests/scrollbar.test
index e511948..7c0b3a7 100644
--- a/tests/scrollbar.test
+++ b/tests/scrollbar.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: scrollbar.test,v 1.11 2004/03/17 18:15:49 das Exp $
+# RCS: @(#) $Id: scrollbar.test,v 1.12 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -96,7 +96,7 @@ foreach test {
 	lindex [.s configure $name] 4
     } [lindex $test 2]
     incr i
-    if {[lindex $test 3] != ""} {
+    if {[lindex $test 3] ne ""} {
 	test scrollbar-1.2 {configuration options} {
 	    list [catch {.s configure $name [lindex $test 3]} msg] $msg
 	} [list 1 [lindex $test 4]]
@@ -639,16 +639,3 @@ catch {destroy .t}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/select.test b/tests/select.test
index 24bae6d..d8b67e3 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: select.test,v 1.12 2004/03/17 18:15:50 das Exp $
+# RCS: @(#) $Id: select.test,v 1.13 2004/05/23 17:34:49 dkf Exp $
 
 #
 # Note: Multiple display selection handling will only be tested if the
@@ -764,50 +764,50 @@ test select-6.39 {Tk_SelectionCmd procedure} {
 
 ##############################################################################
 
-    # This test is non-portable because some old X11/News servers ignore
-    # a selection request when the window doesn't exist, which causes a
-    # different error message.
+# This test is non-portable because some old X11/News servers ignore
+# a selection request when the window doesn't exist, which causes a
+# different error message.
 
-    test select-7.1 {TkSelDeadWindow procedure} {nonPortable} {
-	setup
-	selection handle .f1 { handler TEST }
-	set result [selection own]
-	destroy .f1
-	lappend result [selection own] [catch { selection get } msg] $msg
-    } {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
+test select-7.1 {TkSelDeadWindow procedure} nonPortable {
+    setup
+    selection handle .f1 { handler TEST }
+    set result [selection own]
+    destroy .f1
+    lappend result [selection own] [catch {selection get} msg] $msg
+} {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
 
 ##############################################################################
 
 # Check reentrancy on losing selection
 
-test select-8.1 {TkSelEventProc procedure} {unixOnly} {
+test select-8.1 {TkSelEventProc procedure} -constraints unixOnly -setup {
     setup
     setupbg
-    selection own -selection CLIPBOARD -command { destroy .f1 } .f1
+} -body {
+    selection own -selection CLIPBOARD -command {destroy .f1} .f1
     update
-    set result [dobg {selection own -selection CLIPBOARD .}]
+    dobg {selection own -selection CLIPBOARD .}
+} -cleanup {
     cleanupbg
-    set result
-} {}
+} -result {}
 
 ##############################################################################
 
-test select-9.1 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
-    global selValue selInfo
+test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup {
     setup
     setupbg
+} -constraint unixOnly -body {
     set selValue "1024"
     set selInfo ""
     selection handle -selection PRIMARY -format INTEGER -type TEST \
-	.f1 {handler TEST}
+	    .f1 {handler TEST}
     update
     set result ""
     lappend result [dobg {selection get TEST}]
     cleanupbg
     lappend result $selInfo
-} {0x400 {TEST 0 4000}}
-test select-9.2 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
-    global selValue selInfo
+} -result {0x400 {TEST 0 4000}}
+test select-9.2 {SelCvtToX and SelCvtFromX procedures} unixOnly {
     setup
     setupbg
     set selValue "1024 0xffff  2048 -2  "
@@ -819,8 +819,7 @@ test select-9.2 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
     cleanupbg
     lappend result $selInfo
 } {{0x400 0xffff 0x800 0xfffffffe} {TEST 0 4000}}
-test select-9.3 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
-    global selValue selInfo
+test select-9.3 {SelCvtToX and SelCvtFromX procedures} unixOnly {
     setup
     setupbg
     set selValue "   "
@@ -832,8 +831,7 @@ test select-9.3 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
     cleanupbg
     lappend result $selInfo
 } {{} {TEST 0 4000}}
-test select-9.4 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
-    global selValue selInfo
+test select-9.4 {SelCvtToX and SelCvtFromX procedures} unixOnly {
     setup
     setupbg
     set selValue "16 foobar 32"
@@ -1004,7 +1002,6 @@ test select-12.5 {DefaultSelection procedure} {unixOnly} {
     set result
 } {.f1 .f1}
 test select-12.6 {DefaultSelection procedure} {
-    global selValue selInfo
     setup
     selection handle .f1 {handler TARGETS.f1} TARGETS
     set selValue "Targets value"
@@ -1045,16 +1042,3 @@ catch {rename weirdHandler {}}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/textBTree.test b/tests/textBTree.test
index 85194dc..ed9762e 100644
--- a/tests/textBTree.test
+++ b/tests/textBTree.test
@@ -8,7 +8,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textBTree.test,v 1.6 2003/04/01 21:06:53 dgp Exp $
+# RCS: @(#) $Id: textBTree.test,v 1.7 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -898,16 +898,3 @@ destroy .t
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 7707b8a..f2a7803 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -6,22 +6,16 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textDisp.test,v 1.24 2004/04/21 15:16:45 dkf Exp $
+# RCS: @(#) $Id: textDisp.test,v 1.25 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 namespace import -force tcltest::test
 
-if {[tcltest::testConstraint fonts]} {
-    tcltest::testConstraint textfonts 1
-} else {
-    if {$::tcl_platform(platform) eq "windows"} {
-	tcltest::testConstraint textfonts 1
-    } else {
-	tcltest::testConstraint textfonts 0
-    }
-}
+tcltest::testConstraint textfonts [expr {
+    [tcltest::testConstraint fonts] || $tcl_platform(platform) eq "windows"
+}]
 
 # The procedure below is used as the scrolling command for the text;
 # it just saves the scrolling information in a variable "scrollInfo".
diff --git a/tests/textImage.test b/tests/textImage.test
index 3436875..6b66a1a 100644
--- a/tests/textImage.test
+++ b/tests/textImage.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textImage.test,v 1.8 2003/10/31 09:02:16 vincentdarley Exp $
+# RCS: @(#) $Id: textImage.test,v 1.9 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -352,16 +352,3 @@ font delete test_font
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/textIndex.test b/tests/textIndex.test
index 3186fe0..1dd486a 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textIndex.test,v 1.11 2004/01/07 15:20:53 vincentdarley Exp $
+# RCS: @(#) $Id: textIndex.test,v 1.12 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -871,16 +871,3 @@ rename textimage {}
 catch {destroy .t}
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/textMark.test b/tests/textMark.test
index 70886af..712c724 100644
--- a/tests/textMark.test
+++ b/tests/textMark.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textMark.test,v 1.7 2003/05/19 13:04:24 vincentdarley Exp $
+# RCS: @(#) $Id: textMark.test,v 1.8 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -221,16 +221,3 @@ catch {destroy .t}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/textTag.test b/tests/textTag.test
index 8f39142..21de629 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textTag.test,v 1.9 2003/11/12 17:19:18 vincentdarley Exp $
+# RCS: @(#) $Id: textTag.test,v 1.10 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -802,16 +802,3 @@ catch {destroy .t}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/textWind.test b/tests/textWind.test
index d0c245c..77e84dc 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: textWind.test,v 1.15 2003/12/10 12:14:05 vincentdarley Exp $
+# RCS: @(#) $Id: textWind.test,v 1.16 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -27,11 +27,7 @@ if {[tcltest::testConstraint fonts]} {
 
 option add *Text.borderWidth 2
 option add *Text.highlightThickness 2
-if {$tcl_platform(platform) == "windows"} {
-    option add *Text.font {Courier -12}
-} else {   
-    option add *Text.font {Courier -12}
-}
+option add *Text.font {Courier -12}
 
 set fixedFont {Courier -12}
 # 15 on XP, 13 on Solaris 8
@@ -51,11 +47,7 @@ pack append . .t {top expand fill}
 update
 .t debug on
 wm geometry . {}
-if {[winfo depth .t] > 1} {
-    set color green
-} else {
-    set color black
-}
+set color [expr {[winfo depth .t] > 1 ? "green" : "black"}]
   
 # The statements below reset the main window;  it's needed if the window
 # manager is mwm to make mwm forget about a previous minimum size setting.
@@ -885,16 +877,3 @@ option clear
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test
index 1f0538d..214df36 100644
--- a/tests/unixEmbed.test
+++ b/tests/unixEmbed.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: unixEmbed.test,v 1.12 2003/04/01 21:06:55 dgp Exp $
+# RCS: @(#) $Id: unixEmbed.test,v 1.13 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -559,16 +559,3 @@ deleteWindows
 cleanupbg
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/unixFont.test b/tests/unixFont.test
index 68f8395..c1244c3 100644
--- a/tests/unixFont.test
+++ b/tests/unixFont.test
@@ -12,7 +12,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: unixFont.test,v 1.8 2003/04/01 21:06:56 dgp Exp $
+# RCS: @(#) $Id: unixFont.test,v 1.9 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -314,16 +314,3 @@ test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} unix {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/util.test b/tests/util.test
index 35e8f39..212ea8a 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: util.test,v 1.6 2003/04/01 21:06:58 dgp Exp $
+# RCS: @(#) $Id: util.test,v 1.7 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -66,16 +66,3 @@ test util-1.12 {Tk_GetScrollInfo procedure} {
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/visual.test b/tests/visual.test
index 77dd665..1eb06bc 100644
--- a/tests/visual.test
+++ b/tests/visual.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: visual.test,v 1.7 2003/04/01 21:06:58 dgp Exp $
+# RCS: @(#) $Id: visual.test,v 1.8 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -69,43 +69,46 @@ if {[llength $avail] > 1} {
 	}
     }
 }
+tcltest::testConstraint haveOtherVisual [expr {$other ne ""}]
+tcltest::testConstraint havePseudocolorVisual [string match *pseudocolor* $avail]
+tcltest::testConstraint haveMultipleVisuals [expr {[llength $avail] > 1}]
+tktest::testConstraint defaultPseudocolor8 [expr {
+    ([winfo visual .] == "pseudocolor") && ([winfo depth .] == 8)
+}]
 
 test visual-1.1 {Tk_GetVisual, copying from other window} {
     list [catch {toplevel .t -visual .foo.bar} msg] $msg
 } {1 {bad window path name ".foo.bar"}}
-if {$other != ""} {
-    test visual-1.2 {Tk_GetVisual, copying from other window} {nonPortable} {
-	catch {destroy .t1}
-	catch {destroy .t2}
-	toplevel .t1 -width 250 -height 100 -visual $other
-	wm geom .t1 +0+0
-	toplevel .t2 -width 200 -height 80 -visual .t1
-	wm geom .t2 +5+5
-	concat "[winfo visual .t2] [winfo depth .t2]"
-    } $other
-    test visual-1.3 {Tk_GetVisual, copying from other window} {
-	catch {destroy .t1}
-	catch {destroy .t2}
-	toplevel .t1 -width 250 -height 100 -visual $other
-	wm geom .t1 +0+0
-	toplevel .t2 -width 200 -height 80 -visual .
-	wm geom .t2 +5+5
-	concat "[winfo visual .t2] [winfo depth .t2]"
-    } $default
-
-    # Make sure reference count is incremented when copying visual (the
-    # following test will cause the colormap to be freed prematurely if
-    # the reference count isn't incremented).
-    test visual-1.4 {Tk_GetVisual, colormap reference count} {
-	catch {destroy .t1}
-	catch {destroy .t2}
-	toplevel .t1 -width 250 -height 100 -visual $other
-	wm geom .t1 +0+0
-	set result [list [catch {toplevel .t2 -gorp 80 -visual .t1} msg] $msg]
-	update
-	set result
-    } {1 {unknown option "-gorp"}}
-}
+test visual-1.2 {Tk_GetVisual, copying from other window} {haveOtherVisual nonPortable} {
+    catch {destroy .t1}
+    catch {destroy .t2}
+    toplevel .t1 -width 250 -height 100 -visual $other
+    wm geom .t1 +0+0
+    toplevel .t2 -width 200 -height 80 -visual .t1
+    wm geom .t2 +5+5
+    concat "[winfo visual .t2] [winfo depth .t2]"
+} $other
+test visual-1.3 {Tk_GetVisual, copying from other window} haveOtherVisual {
+    catch {destroy .t1}
+    catch {destroy .t2}
+    toplevel .t1 -width 250 -height 100 -visual $other
+    wm geom .t1 +0+0
+    toplevel .t2 -width 200 -height 80 -visual .
+    wm geom .t2 +5+5
+    concat "[winfo visual .t2] [winfo depth .t2]"
+} $default
+# Make sure reference count is incremented when copying visual (the
+# following test will cause the colormap to be freed prematurely if
+# the reference count isn't incremented).
+test visual-1.4 {Tk_GetVisual, colormap reference count} haveOtherVisual {
+    catch {destroy .t1}
+    catch {destroy .t2}
+    toplevel .t1 -width 250 -height 100 -visual $other
+    wm geom .t1 +0+0
+    set result [list [catch {toplevel .t2 -gorp 80 -visual .t1} msg] $msg]
+    update
+    set result
+} {1 {unknown option "-gorp"}}
 test visual-1.5 {Tk_GetVisual, default colormap} {
     catch {destroy .t1}
     toplevel .t1 -width 250 -height 100 -visual default
@@ -163,7 +166,7 @@ test visual-3.5 {Tk_GetVisual, parsing visual string} {
     } msg] $msg
 } {1 {expected integer but got "48x"}}
 
-if {$other != ""} {
+test visual-4.1 {Tk_GetVisual, numerical visual id} -setup {
     catch {destroy .t1}
     catch {destroy .t2}
     catch {destroy .t3}
@@ -173,95 +176,93 @@ if {$other != ""} {
     wm geom .t2 +5+5
     toplevel .t3 -width 150 -height 250 -visual [winfo visual .t1]
     wm geom .t3 +10+10
-    test visual-4.1 {Tk_GetVisual, numerical visual id} nonPortable {
-	list [winfo visualid .t2] [winfo visualid .t3]
-    } [list [winfo visualid .] [winfo visualid .t1]]
+} -constraints {haveOtherVisual nonPortable} -body {
+    set v1 [list [winfo visualid .t2] [winfo visualid .t3]]
+    set v2 [list [winfo visualid .] [winfo visualid .t1]]
+    expr {$v1 eq $v2 ? "OK" : "[list $v1] ne [list $v2]"}
+} -result OK -cleanup {
     destroy .t1 .t2 .t3
 }
 test visual-4.2 {Tk_GetVisual, numerical visual id} {
     catch {destroy .t1}
     list [catch {toplevel .t1 -visual 12xyz} msg] $msg
-} {1 {bad X identifier for visual: 12xyz"}}
+} {1 {bad X identifier for visual: "12xyz"}}
 test visual-4.3 {Tk_GetVisual, numerical visual id} {
     catch {destroy .t1}
     list [catch {toplevel .t1 -visual 1291673} msg] $msg
 } {1 {couldn't find an appropriate visual}}
 
-if ![string match *pseudocolor* $avail] {
-    test visual-5.1 {Tk_GetVisual, no matching visual} {
-	catch {destroy .t1}
-	list [catch {
-	    toplevel .t1 -width 250 -height 100 -visual "pseudocolor 8"
-	    wm geometry .t1 +0+0
-	} msg] $msg
-    } {1 {couldn't find an appropriate visual}}
-}
-
-if {[string match *pseudocolor* $avail] && ([llength $avail] > 1)} {
-    test visual-6.1 {Tk_GetVisual, no matching visual} {nonPortable} {
-	catch {destroy .t1}
-	toplevel .t1 -width 250 -height 100 -visual "best"
+test visual-5.1 {Tk_GetVisual, no matching visual} !havePseudocolorVisual {
+    catch {destroy .t1}
+    list [catch {
+	toplevel .t1 -width 250 -height 100 -visual "pseudocolor 8"
 	wm geometry .t1 +0+0
-	update
-	winfo visual .t1
-    } {pseudocolor}
-}
+    } msg] $msg
+} {1 {couldn't find an appropriate visual}}
+
+test visual-6.1 {Tk_GetVisual, no matching visual} {havePseudocolorVisual haveMultipleVisuals nonPortable} {
+    catch {destroy .t1}
+    toplevel .t1 -width 250 -height 100 -visual "best"
+    wm geometry .t1 +0+0
+    update
+    winfo visual .t1
+} {pseudocolor}
 
 # These tests are non-portable due to variations in how many colors
 # are already in use on the screen.
 
-if {([winfo visual .] == "pseudocolor") && ([winfo depth .] == 8)} {
+if {[tktest::testConstraint defaultPseudocolor8]} {
     eatColors .t1
-    test visual-7.1 {Tk_GetColormap, "new"} {nonPortable} {
-	toplevel .t2 -width 30 -height 20
-	wm geom .t2 +0+0
-	update
-	colorsFree .t2
-    } {0}
-    test visual-7.2 {Tk_GetColormap, "new"} {nonPortable} {
-	catch {destroy .t2}
-	toplevel .t2 -width 30 -height 20 -colormap new
-	wm geom .t2 +0+0
-	update
-	colorsFree .t2
-    } {1}
-    test visual-7.3 {Tk_GetColormap, copy from other window} {nonPortable} {
-	catch {destroy .t2}
-	toplevel .t3 -width 400 -height 50 -colormap new
-	wm geom .t3 +0+0
-	catch {destroy .t2}
-	toplevel .t2 -width 30 -height 20 -colormap .t3
-	wm geom .t2 +0+0
-	update
-	destroy .t3
-	colorsFree .t2
-    } {1}
-    test visual-7.4 {Tk_GetColormap, copy from other window} {nonPortable} {
-	catch {destroy .t2}
-	toplevel .t3 -width 400 -height 50 -colormap new
-	wm geom .t3 +0+0
-	catch {destroy .t2}
-	toplevel .t2 -width 30 -height 20 -colormap .
-	wm geom .t2 +0+0
-	update
-	destroy .t3
-	colorsFree .t2
-    } {0}
-    test visual-7.5 {Tk_GetColormap, copy from other window} {nonPortable} {
-	catch {destroy .t1}
-	list [catch {toplevel .t1 -width 400 -height 50 \
-		-colormap .choke.lots} msg] $msg
-    } {1 {bad window path name ".choke.lots"}}
-    if {$other != {}} {
-	test visual-7.6 {Tk_GetColormap, copy from other window} {nonPortable} {
-	    catch {destroy .t1}
-	    catch {destroy .t2}
-	    toplevel .t1 -width 300 -height 150 -visual $other
-	    wm geometry .t1 +0+0
-	    list [catch {toplevel .t2 -width 400 -height 50 \
-		    -colormap .t1} msg] $msg
-	} {1 {can't use colormap for .t1: incompatible visuals}}
-    }
+}
+test visual-7.1 {Tk_GetColormap, "new"} {defaultPseudocolor8 nonPortable} {
+    toplevel .t2 -width 30 -height 20
+    wm geom .t2 +0+0
+    update
+    colorsFree .t2
+} {0}
+test visual-7.2 {Tk_GetColormap, "new"} {defaultPseudocolor8 nonPortable} {
+    catch {destroy .t2}
+    toplevel .t2 -width 30 -height 20 -colormap new
+    wm geom .t2 +0+0
+    update
+    colorsFree .t2
+} {1}
+test visual-7.3 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} {
+    catch {destroy .t2}
+    toplevel .t3 -width 400 -height 50 -colormap new
+    wm geom .t3 +0+0
+    catch {destroy .t2}
+    toplevel .t2 -width 30 -height 20 -colormap .t3
+    wm geom .t2 +0+0
+    update
+    destroy .t3
+    colorsFree .t2
+} {1}
+test visual-7.4 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} {
+    catch {destroy .t2}
+    toplevel .t3 -width 400 -height 50 -colormap new
+    wm geom .t3 +0+0
+    catch {destroy .t2}
+    toplevel .t2 -width 30 -height 20 -colormap .
+    wm geom .t2 +0+0
+    update
+    destroy .t3
+    colorsFree .t2
+} {0}
+test visual-7.5 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} {
+    catch {destroy .t1}
+    list [catch {
+	toplevel .t1 -width 400 -height 50 -colormap .choke.lots
+    } msg] $msg
+} {1 {bad window path name ".choke.lots"}}
+test visual-7.6 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 haveOtherVisual nonPortable} {
+    catch {destroy .t1}
+    catch {destroy .t2}
+    toplevel .t1 -width 300 -height 150 -visual $other
+    wm geometry .t1 +0+0
+    list [catch {toplevel .t2 -width 400 -height 50 -colormap .t1} msg] $msg
+} {1 {can't use colormap for .t1: incompatible visuals}}
+if {[tktest::testConstraint defaultPseudocolor8]} {
     catch {destroy .t1}
     catch {destroy .t2}
 }
@@ -279,21 +280,19 @@ test visual-8.1 {Tk_FreeColormap procedure} {
     destroy .t4
     update
 } {}
-if {$other != {}} {
-    test visual-8.2 {Tk_FreeColormap procedure} {
-	deleteWindows
-	toplevel .t1 -width 300 -height 180 -visual $other
-	wm geometry .t1 +0+0
-	foreach i {.t2 .t3 .t4} {
-	    toplevel $i -width 250 -height 150 -visual $other
-	    wm geometry $i +0+0
-	}
-	destroy .t2
-	destroy .t3
-	destroy .t4
-	update
-    } {}
-}
+test visual-8.2 {Tk_FreeColormap procedure} haveOtherVisual {
+    deleteWindows
+    toplevel .t1 -width 300 -height 180 -visual $other
+    wm geometry .t1 +0+0
+    foreach i {.t2 .t3 .t4} {
+	toplevel $i -width 250 -height 150 -visual $other
+	wm geometry $i +0+0
+    }
+    destroy .t2
+    destroy .t3
+    destroy .t4
+    update
+} {}
 
 deleteWindows
 rename eatColors {}
@@ -302,16 +301,3 @@ rename colorsFree {}
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/winMenu.test b/tests/winMenu.test
index 5e76440..0c56507 100644
--- a/tests/winMenu.test
+++ b/tests/winMenu.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: winMenu.test,v 1.7 2003/04/01 21:07:01 dgp Exp $
+# RCS: @(#) $Id: winMenu.test,v 1.8 2004/05/23 17:34:49 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -1034,15 +1034,3 @@ test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest pcOnly} {} {}
 deleteWindows
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/winSend.test b/tests/winSend.test
index d95e102..089ea85 100644
--- a/tests/winSend.test
+++ b/tests/winSend.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: winSend.test,v 1.5 2003/04/01 21:07:02 dgp Exp $
+# RCS: @(#) $Id: winSend.test,v 1.6 2004/05/23 17:34:50 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -36,27 +36,32 @@ proc newApp {name {safe {}}} {
 }
 
 set currentInterps [winfo interps]
-if {[testConstraint win] && [llength [info commands send]]} {
+if {
+    [testConstraint win] &&
+    [llength [info commands send]] &&
+    [catch {exec [interpreter] &}] == 0
+} then {
+    # Wait until the child application has launched.
+    while {[llength [winfo interps]] == [llength $currentInterps]} {}
 
-    if {[catch {exec [interpreter] &}] == 0} {
-
-	# Wait until the child application has launched.
-	while {[llength [winfo interps]] == [llength $currentInterps]} {}
-
-	# Now find an interp to send to
-	set newInterps [winfo interps]
-	foreach interp $newInterps {
-	    if {[lsearch -exact $currentInterps $interp] < 0} {
-		break
-	    }
+    # Now find an interp to send to
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch -exact $currentInterps $interp] < 0} {
+	    break
 	}
-
-	# Now we have found our interpreter we are going to send to.
-	# Make sure that it works first.
-	testConstraint winSend	[expr {[catch {
-					send $interp {console hide; update}
-				}] == 0}]
     }
+
+    # Now we have found our interpreter we are going to send to.
+    # Make sure that it works first.
+    testConstraint winSend [expr {![catch {
+	send $interp {
+	    console hide
+	    update
+	}
+    }]}]
+} else {
+    testConstraint winSend 0
 }
 
 # setting up dde server is done when the first interp is created and
@@ -65,9 +70,7 @@ test winSend-1.1 {Tk_SetAppName - changing name of interp} winSend {
     newApp testApp
     list [testApp eval tk appname testApp2] [interp delete testApp]
 } {testApp2 {}}
-test winSend-1.2 {Tk_SetAppName - changing name - not front of linked list} {
-	winSend
-} {
+test winSend-1.2 {Tk_SetAppName - changing name - not front of linked list} winSend {
     newApp testApp
     newApp testApp2
     list [testApp eval tk appname testApp3] [interp delete testApp] [interp delete testApp2]
@@ -404,4 +407,3 @@ while {[llength $newInterps] != [llength $currentInterps]} {
 # cleanup
 cleanupTests
 return
-
diff --git a/tests/window.test b/tests/window.test
index db80f97..1bdcd6f 100644
--- a/tests/window.test
+++ b/tests/window.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: window.test,v 1.9 2003/11/18 01:47:51 dgp Exp $
+# RCS: @(#) $Id: window.test,v 1.10 2004/05/23 17:34:50 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -304,15 +304,3 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \
 # cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/wm.test b/tests/wm.test
index 255efc4..24a8ee2 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: wm.test,v 1.24 2004/03/17 18:15:50 das Exp $
+# RCS: @(#) $Id: wm.test,v 1.25 2004/05/23 17:34:50 dkf Exp $
 
 # This file tests window manager interactions that work across
 # platforms. Window manager tests that only work on a specific
@@ -1786,6 +1786,3 @@ test wm-deletion-epoch-1.1 {Deletion epoch on multiple displays} {altDisplay} {
 deleteWindows
 cleanupTests
 return
-
-
-
diff --git a/tests/xmfbox.test b/tests/xmfbox.test
index ca3858a..c2f3edd 100644
--- a/tests/xmfbox.test
+++ b/tests/xmfbox.test
@@ -10,7 +10,7 @@
 # Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
 # All rights reserved.
 #
-# RCS: @(#) $Id: xmfbox.test,v 1.8 2003/04/01 21:07:05 dgp Exp $
+# RCS: @(#) $Id: xmfbox.test,v 1.9 2004/05/23 17:34:50 dkf Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -141,15 +141,3 @@ test xmfbox-2.6 {tk::MotifFDialog_ActivateFList, ~ in file names} {unixOnly} {
 cleanup
 cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-- 
cgit v0.12