* Merged 8.1 branch into the main trunk

99 files changed, 8632 insertions, 2671 deletions

diff --git a/tests/README b/tests/README
index 23fc4a5..facea75 100644
--- a/tests/README
+++ b/tests/README
@@ -1,30 +1,7 @@
-Tk Test Suite
---------------
+README -- Tk test suite design document.
 
-RCS: @(#) $Id: README,v 1.2 1998/09/14 18:23:41 stanton Exp $
+RCS: @(#) $Id: README,v 1.3 1999/04/16 01:51:33 stanton Exp $
 
-This directory contains a set of validation tests for Tk.
-Each of the files whose name ends in ".test" is intended to
-fully exercise one or a few Tk features.  The features
-tested by a given file are listed in the first line of the
-file.  The test suite is nowhere near complete yet.  Contributions
-of additional tests would be most welcome.
-
-You can run the tests in two ways:
-    (a) type "make test" in the directory ../unix; this will run all of
-        the tests.
-    (b) start up tktest in this directory, then "source" the test
-        file (for example, type "source pack.test").  To run all
-	of the tests, type "source all".
-In either case no output will be generated if all goes well, except
-for a listing of the tests.  If there are errors then additional
-messages will appear.
-
-For more details on the testing environment, see the README
-file in the Tcl test directory.
-
-You can also run a set of visual tests, which create various screens
-that you can verify visually for appropriate behavior.  The visual
-tests are available through the "visual" script:  if you invoke this
-script, it creates a main window with a bunch of menus.  Each menu
-runs a particular test.
+This directory contains a set of validation tests for the Tk commands.
+Please see the tests/README file in the Tcl source distribution for
+information about the test suite.
diff --git a/tests/all b/tests/all
deleted file mode 100644
index 9a473ef..0000000
--- a/tests/all
+++ /dev/null
@@ -1,84 +0,0 @@
-# This file contains a top-level script to run all of the Tcl
-# tests.  Execute it by invoking "source all" when running tclTest
-# in this directory.
-#
-# RCS: @(#) $Id: all,v 1.6 1999/04/16 01:25:55 stanton Exp $
-
-set TESTS_DIR [file join [pwd] [file dirname [info script]]]
-source [file join $TESTS_DIR defs]
-set currentDir [pwd]
-
-catch {array set flag $argv}
-set requiredSourceFiles [list arc.tcl bugs.tcl butGeom2.tcl \
-	canvPsBmap.tcl canvPsText.tcl bevel.tcl butGeom.tcl \
-	canvPsArc.tcl canvPsGrph.tcl cmap.tcl filebox.test \
-	option.file1 option.file2 visual README defs]
-
-#
-# Set the TMP_DIR to pwd or the arg of -tmpdir, if given.
-# 
-
-if {[info exists flag(-tmpdir)]} {
-    set TMP_DIR $flag(-tmpdir)
-    if {![file exists $TMP_DIR]} {
-	if {[catch {file mkdir $TMP_DIR} msg]} {
-	    error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$msg"
-	}
-	file mkdir $TMP_DIR
-    } elseif {![file isdir $TMP_DIR]} {
-	error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$TMP_DIR is not a directory"
-    }
-    if {[string compare [file pathtype $TMP_DIR] absolute] != 0} {
-	set TMP_DIR [file join [pwd] $TMP_DIR]
-    }
-    cd $TMP_DIR
-}
-
-#
-# copy each required source file to the current dir (if it's not already there).
-#
-
-if {[string compare $TESTS_DIR [pwd]] != 0} {
-
-    foreach file $requiredSourceFiles {
-	if {![file exists $file]} {
-	    catch {file copy [file join $TESTS_DIR $file] .}
-	}
-    }
-}
-
-if {$tcl_platform(os) == "Win32s"} {
-    set globPattern [file join $TESTS_DIR *.tes]
-} else {
-    set globPattern [file join $TESTS_DIR *.test]
-}
-
-foreach file [lsort [glob $globPattern]] {
-    set tail [file tail $file]
-    if {[string match l.*.test $tail]} {
-	# This is an SCCS lockfile; ignore it
-	continue
-    }
-    puts stdout $tail
-    if {[catch {source $file} msg]} {
-	puts stdout $msg
-    }
-}
-
-# remove the required source files from the current dir.
-if {[info exists TMP_DIR]} {
-    foreach file $requiredSourceFiles {
-        catch {file delete -force $file}
-    }
-    cd $currentDir
-}
-
-# exit if Tk is running in non-interactive mode.
-# Don't exit at the end of all the tests on the Mac, since
-# this destroys the window that contains the test results...
-
-if {([info exists tk_version] && !$tcl_interactive) \
-	|| [string compare $tcl_platform(platform) macintosh]} {
-    catch {destroy .}
-    exit
-}
diff --git a/tests/all.tcl b/tests/all.tcl
new file mode 100644
index 0000000..fc2b89d
--- /dev/null
+++ b/tests/all.tcl
@@ -0,0 +1,78 @@
+# all.tcl --
+#
+# This file contains a top-level script to run all of the Tk
+# tests.  Execute it by invoking "source all.tcl" when running tktest
+# in this directory.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id: all.tcl,v 1.2 1999/04/16 01:51:33 stanton Exp $
+
+if {[lsearch ::tcltest [namespace children]] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+set ::tcltest::testSingleFile false
+
+puts stdout "Tk $tk_patchLevel tests running in interp:  [info nameofexecutable]"
+puts stdout "Tests running in working dir:  $::tcltest::workingDir"
+if {[llength $::tcltest::skip] > 0} {
+    puts stdout "Skipping tests that match:  $::tcltest::skip"
+}
+if {[llength $::tcltest::match] > 0} {
+    puts stdout "Only running tests that match:  $::tcltest::match"
+}
+
+# Use command line specified glob pattern (specified by -file or -f)
+# if one exists.  Otherwise use *.test.  If given, the file pattern
+# should be specified relative to the dir containing this file.  If no
+# files are found to match the pattern, print an error message and exit.
+set fileIndex [expr {[lsearch $argv "-file"] + 1}]
+set fIndex [expr {[lsearch $argv "-f"] + 1}]
+if {($fileIndex < 1) || ($fIndex > $fileIndex)} {
+    set fileIndex $fIndex
+}
+if {$fileIndex > 0} {
+    set globPattern [file join $::tcltest::testsDir [lindex $argv $fileIndex]]
+    puts stdout "Sourcing files that match:  $globPattern"
+} else {
+    set globPattern [file join $::tcltest::testsDir *.test]
+}
+set fileList [glob -nocomplain $globPattern]
+if {[llength $fileList] < 1} {
+    puts "Error: no files found matching $globPattern"
+    exit
+}
+set timeCmd {clock format [clock seconds]}
+puts stdout "Tests began at [eval $timeCmd]"
+
+# source each of the specified tests
+foreach file [lsort $fileList] {
+    set tail [file tail $file]
+    if {[string match l.*.test $tail]} {
+	# This is an SCCS lockfile; ignore it
+	continue
+    }
+    puts stdout $tail
+    if {[catch {source $file} msg]} {
+	puts stdout $msg
+    }
+}
+
+# cleanup
+puts stdout "\nTests ended at [eval $timeCmd]"
+::tcltest::cleanupTests 1
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/arc.tcl b/tests/arc.tcl
index 33056f5..4315361 100644
--- a/tests/arc.tcl
+++ b/tests/arc.tcl
@@ -1,7 +1,7 @@
 # This file creates a visual test for arcs.  It is part of the Tk
 # visual test suite, which is invoked via the "visual" script.
 #
-# RCS: @(#) $Id: arc.tcl,v 1.2 1998/09/14 18:23:42 stanton Exp $
+# RCS: @(#) $Id: arc.tcl,v 1.3 1999/04/16 01:51:33 stanton Exp $
 
 catch {destroy .t}
 toplevel .t
@@ -138,3 +138,16 @@ bind .t.c a {
 bind .t.c b {set go 0}
 
 bind .t.c <Control-x> {.t.c delete current}
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/bell.test b/tests/bell.test
index 0c88769..e8c2040 100644
--- a/tests/bell.test
+++ b/tests/bell.test
@@ -2,16 +2,13 @@
 # It is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: bell.test,v 1.3 1998/09/30 19:01:22 rjohnson Exp $
+# RCS: @(#) $Id: bell.test,v 1.4 1999/04/16 01:51:33 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 test bell-1.1 {bell command} {
@@ -29,9 +26,24 @@ test bell-1.4 {bell command} {
     after 500
     bell -displayof .
     after 200
-    bell -dis .
-    after 200
     bell
     after 200
     bell
 } {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/bevel.tcl b/tests/bevel.tcl
index 815590a..ae6039a 100644
--- a/tests/bevel.tcl
+++ b/tests/bevel.tcl
@@ -2,7 +2,7 @@
 # widgets.  It is part of the Tk visual test suite, which is invoked
 # via the "visual" script.
 #
-# RCS: @(#) $Id: bevel.tcl,v 1.2 1998/09/14 18:23:42 stanton Exp $
+# RCS: @(#) $Id: bevel.tcl,v 1.3 1999/04/16 01:51:33 stanton Exp $
 
 catch {destroy .t}
 toplevel .t
@@ -126,3 +126,16 @@ foreach i {1 2 3} {
 .t.t insert end rrr r1
 .t.t insert end *****
 .t.t insert end rrr r1
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/bgerror.test b/tests/bgerror.test
index b718483..cf6489b 100644
--- a/tests/bgerror.test
+++ b/tests/bgerror.test
@@ -2,17 +2,15 @@
 # It is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: bgerror.test,v 1.2 1998/09/14 18:23:42 stanton Exp $
+# RCS: @(#) $Id: bgerror.test,v 1.3 1999/04/16 01:51:33 stanton Exp $
 
-if {[info commands test] == ""} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
-
 test bgerror-1.1 {bgerror / tkerror compat} {
     set errRes {}
     proc tkerror {err} {
@@ -57,3 +55,19 @@ catch {rename tkerror {}}
 # would be needed too, but that's not easy at all
 # to emulate.
 
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/bind.test b/tests/bind.test
index e3e5f51..a62b7a1 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -4,15 +4,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: bind.test,v 1.4 1998/10/10 00:30:37 rjohnson Exp $
+# RCS: @(#) $Id: bind.test,v 1.5 1999/04/16 01:51:34 stanton Exp $
 
-if {[string compare test [info procs test]] != 0} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 catch {destroy .b}
@@ -254,7 +252,7 @@ test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} {
     set x
 } {a1 bye.all2 bye.a1 b1 bye.c1}
 
-test bind-7.1 {Tk_CreateBinding procedure: error} {
+test bind-7.1 {Tk_CreateBinding procedure: bad binding} {
     catch {destroy .b.c}
     canvas .b.c
     list [catch {.b.c bind foo <} msg] $msg
@@ -1470,8 +1468,11 @@ test bind-16.35 {ExpandPercents procedure} {nonPortable} {
     event gen .b.f <Key-space>
     event gen .b.f <Key-dollar> -state 1
     event gen .b.f <Key-braceleft> -state 1
+    event gen .b.f <Key-Multi_key>
+    event gen .b.f <Key-e>
+    event gen .b.f <Key-apostrophe>
     set x
-} "a A {	} {\r} {{}} {{}} { } {\$} \\\{"
+} "a A {	} {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9"
 test bind-16.36 {ExpandPercents procedure} {
     setup
     bind .b.f <Configure> {set x "%B"}
@@ -1539,10 +1540,10 @@ test bind-16.43 {ExpandPercents procedure} {
 
 test bind-17.1 {event command} {
     list [catch {event} msg] $msg
-} {1 {wrong # args: should be "event option ?arg1?"}}
+} {1 {wrong # args: should be "event option ?arg?"}}
 test bind-17.2 {event command} {
-    list [catch {event {}} msg] $msg
-} {1 {bad option "": should be add, delete, generate, info}}
+    list [catch {event xyz} msg] $msg
+} {1 {bad option "xyz": must be add, delete, generate, or info}}
 test bind-17.3 {event command: add} {
     list [catch {event add} msg] $msg
 } {1 {wrong # args: should be "event add virtual sequence ?sequence ...?"}}
@@ -1611,8 +1612,7 @@ test bind-17.16 {event command: generate} {
 } {1 {bad event type or keysym "xyz"}}
 test bind-17.17 {event command} {
     list [catch {event foo} msg] $msg
-} {1 {bad option "foo": should be add, delete, generate, info}}
-
+} {1 {bad option "foo": must be add, delete, generate, or info}}
 
 test bind-18.1 {CreateVirtualEvent procedure: GetVirtualEventUid} {
     list [catch {event add asd <Ctrl-v>} msg] $msg
@@ -1971,73 +1971,73 @@ test bind-22.16 {HandleEventGenerate} {
 } {foo 99 100 101 102}
 test bind-22.17 {HandleEventGenerate} {
     list [catch {event gen . <Button> -when xyz} msg] $msg
-} {1 {bad position "xyz": should be now, head, mark, tail}}
-set i 14
+} {1 {bad -when value "xyz": must be now, head, mark, or tail}}
+set i 18
 foreach check {
     {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
     {<Configure> %a {-above .b} {[winfo id .b]}}
-    {<Configure> %a {-above xyz} {{1 {expected integer but got "xyz"}}}}
+    {<Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}}
     {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
-    {<Key> %b    {-above .} {{1 {bad option to <Key> event: "-above"}}}}
+    {<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 {bad option to <Key> event: "-borderwidth"}}}}
+    {<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}
-    {<Key> %k	    {-button 1} {{1 {bad option to <Key> event: "-button"}}}}
+    {<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 {bad option to <Key> event: "-count"}}}}
+    {<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, NotifyDetailNone}}}}
+    {<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 {bad option to <Key> event: "-detail"}}}}
+    {<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 {bad option to <Key> event: "-focus"}}}}
+    {<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 {bad option to <Key> event: "-height"}}}}
+    {<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 {bad option to <Button> event: "-keycode"}}}}
+    {<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 {bad option to <Button> event: "-keysym"}}}}
+    {<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, NotifyWhileGrabbed}}}}
+    {<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 {bad option to <Key> event: "-mode"}}}}
+    {<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 {bad option to <Key> event: "-override"}}}}
+    {<Key> %k	    {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}}
 
-    {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, PlaceOnBottom}}}}
+    {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}}
     {<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
-    {<Key> %k	    {-place PlaceOnTop} {{1 {bad option to <Key> event: "-place"}}}}
+    {<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 {expected integer but got "xyz"}}}}
+    {<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]}}
     {<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 {bad option to <Configure> event: "-root"}}}}
+    {<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]}}
@@ -2045,7 +2045,7 @@ foreach check {
     {<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 {bad option to <Configure> event: "-rootx"}}}}
+    {<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]}}
@@ -2053,7 +2053,7 @@ foreach check {
     {<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 {bad option to <Configure> event: "-rooty"}}}}
+    {<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}
@@ -2069,19 +2069,19 @@ foreach check {
     {<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, VisibilityFullyObscured}}}}
+    {<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 {bad option to <Configure> event: "-state"}}}}
+    {<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 {expected integer but got "xyz"}}}}
+    {<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]}}
     {<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 {bad option to <Configure> event: "-subwindow"}}}}
+    {<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}
@@ -2090,16 +2090,16 @@ foreach check {
     {<<Paste>> %t   {-time 100} 100}
     {<Enter> %t	    {-time 100} 100}
     {<Property> %t  {-time 100} 100}
-    {<Configure> %t {-time 100} {{1 {bad option to <Configure> event: "-time"}}}}
+    {<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 {bad option to <Key> event: "-width"}}}}
+    {<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 {expected integer but got "xyz"}}}}
+    {<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}
@@ -2107,7 +2107,7 @@ foreach check {
     {<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 {bad option to <Key> event: "-window"}}}}
+    {<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]}}
@@ -2119,7 +2119,7 @@ foreach check {
     {<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 {bad option to <Map> event: "-x"}}}}
+    {<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]}}
@@ -2131,9 +2131,9 @@ foreach check {
     {<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 {bad option to <Map> event: "-y"}}}}
+    {<Map> %y	    {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}}
 
-    {<Key> %k	    {-xyz 1} {{1 {bad option to <Key> event: "-xyz"}}}}
+    {<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, -width, -window, -x, or -y}}}}
 } {
     set event [lindex $check 0]
     test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" {
@@ -2244,7 +2244,17 @@ test bind-24.12 {FindSequence procedure: not new sequence, don't create} {
     bind .b.f <Control-Button-2> "foo"
     bind .b.f <Button-2>
 } {}
-
+test bind-24.13 {FindSequence procedure: no binding} {
+    catch {destroy .b.f}
+    frame .b.f -class Test -width 150 -height 100
+    list [catch {bind .b.f <a>} msg] $msg
+} {0 {}}
+test bind-24.14 {FindSequence procedure: no binding} {
+    catch {destroy .b.f}
+    canvas .b.f
+    set i [.b.f create rect 10 10 100 100]
+    list [catch {.b.f bind $i <a>} msg] $msg
+} {0 {}}
 
 test bind-25.1 {ParseEventDescription procedure} {
     list [catch {bind .b \x7 test} msg] $msg
@@ -2557,3 +2567,20 @@ test bind-31.2 {MouseWheel events} {
 
 
 destroy .b
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/bitmap.test b/tests/bitmap.test
new file mode 100644
index 0000000..2049840
--- /dev/null
+++ b/tests/bitmap.test
@@ -0,0 +1,116 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkBitmap.c.  It is organized in the standard white-box fashion for
+# Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: bitmap.test,v 1.2 1999/04/16 01:51:34 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info commands testbitmap] != "testbitmap"} {
+    puts "testbitmap command not available; skipping tests"
+    ::tcltest::cleanupTests
+    return
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} {
+    set x gray25
+    lindex $x 0
+    destroy .b1
+    button .b1 -bitmap $x
+    lindex $x 0
+    testbitmap gray25
+} {{1 0}}
+test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} {
+    set x gray25
+    destroy .b1 .b2
+    button .b1 -bitmap $x
+    destroy .b1
+    set result {}
+    lappend result [testbitmap gray25]
+    button .b2 -bitmap $x
+    lappend result [testbitmap gray25]
+} {{} {{1 1}}}
+test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} {
+    set x gray25
+    destroy .b1 .b2
+    button .b1 -bitmap $x
+    set result {}
+    lappend result [testbitmap gray25]
+    button .b2 -bitmap $x
+    pack .b1 .b2 -side top
+    lappend result [testbitmap gray25]
+} {{{1 1}} {{2 1}}}
+
+test bitmap-2.1 {Tk_GetBitmap procedure} {
+    destroy .b1
+    list [catch {button .b1 -bitmap bad_name} msg] $msg
+} {1 {bitmap "bad_name" not defined}}
+test bitmap-2.2 {Tk_GetBitmap procedure} {
+    destroy .b1
+    list [catch {button .b1 -bitmap @xyzzy} msg] $msg
+} {1 {error reading bitmap file "xyzzy"}}
+
+test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} {
+    set x questhead
+    destroy .b1 .b2 .b3
+    button .b1 -bitmap $x
+    button .b3 -bitmap $x
+    button .b2 -bitmap $x
+    set result {}
+    lappend result [testbitmap questhead]
+    destroy .b1
+    lappend result [testbitmap questhead]
+    destroy .b2
+    lappend result [testbitmap questhead]
+    destroy .b3
+    lappend result [testbitmap questhead]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+
+test bitmap-4.1 {FreeBitmapObjProc} {
+    destroy .b
+    set x [format questhead]
+    button .b -bitmap $x
+    set y [format questhead]
+    .b configure -bitmap $y
+    set z [format questhead]
+    .b configure -bitmap $z
+    set result {}
+    lappend result [testbitmap questhead]
+    set x red
+    lappend result [testbitmap questhead]
+    set z 32
+    lappend result [testbitmap questhead]
+    destroy .b
+    lappend result [testbitmap questhead]
+    set y bogus
+    set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/border.test b/tests/border.test
new file mode 100644
index 0000000..e59b405
--- /dev/null
+++ b/tests/border.test
@@ -0,0 +1,195 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkBorder.c.  It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: border.test,v 1.2 1999/04/16 01:51:34 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info commands testborder] != "testborder"} {
+    puts "testborder command not available; skipping tests"
+    ::tcltest::cleanupTests
+    return
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+# Create a top-level with its own colormap (so we can test under
+# controlled conditions), then check to make sure that the visual
+# is color-mapped with 256 borders.  If not, just skip this whole
+# test file.
+
+if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] {
+    ::tcltest::cleanupTests
+    return
+}
+wm geom .t +0+0
+if {[winfo depth .t] != 8} {
+    destroy .t
+    ::tcltest::cleanupTests
+    return
+}
+
+test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} {
+    set x orange
+    lindex $x 0
+    destroy .b1
+    button .b1 -bg $x -text .b1
+    lindex $x 0
+    testborder orange
+} {{1 0}}
+test border-1.3 {Tk_AllocBorderFromObj - discard stale border} {
+    set x orange
+    destroy .b1 .b2
+    button .b1 -bg $x -text First
+    destroy .b1
+    set result {}
+    lappend result [testborder orange]
+    button .b2 -bg $x -text Second
+    lappend result [testborder orange]
+} {{} {{1 1}}}
+test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} {
+    set x orange
+    destroy .b1 .b2
+    button .b1 -bg $x -text First
+    set result {}
+    lappend result [testborder orange]
+    button .b2 -bg $x -text Second
+    pack .b1 .b2 -side top
+    lappend result [testborder orange]
+} {{{1 1}} {{2 1}}}
+test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {
+    set x purple
+    destroy .b1 .b2 .t.b
+    button .b1 -bg $x -text First
+    pack .b1 -side top
+    set result {}
+    lappend result [testborder purple]
+    button .t.b -bg $x -text Second
+    pack .t.b -side top
+    lappend result [testborder purple]
+    button .b2 -bg $x -text Third
+    pack .b2 -side top
+    lappend result [testborder purple]
+} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}
+
+test border-3.1 {Tk_Free3DBorder - reference counts} {
+    set x purple
+    destroy .b1 .b2 .t.b
+    button .b1 -bg $x -text First
+    pack .b1 -side top
+    button .t.b -bg $x -text Second
+    pack .t.b -side top
+    button .b2 -bg $x -text Third
+    pack .b2 -side top
+    set result {}
+    lappend result [testborder purple]
+    destroy .b1
+    lappend result [testborder purple]
+    destroy .b2
+    lappend result [testborder purple]
+    destroy .t.b
+    lappend result [testborder purple]
+} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
+test border-3.4 {Tk_Free3DBorder - unlinking from list} {
+    destroy .b .t.b .t2 .t3
+    toplevel .t2 -visual {pseudocolor 8} -colormap new
+    toplevel .t3 -visual {pseudocolor 8} -colormap new
+    set x purple
+    button .b -bg $x -text .b1
+    button .t.b1 -bg $x -text .t.b1
+    button .t.b2 -bg $x -text .t.b2
+    button .t2.b1 -bg $x -text .t2.b1
+    button .t2.b2 -bg $x -text .t2.b2
+    button .t2.b3 -bg $x -text .t2.b3
+    button .t3.b1 -bg $x -text .t3.b1
+    button .t3.b2 -bg $x -text .t3.b2
+    button .t3.b3 -bg $x -text .t3.b3
+    button .t3.b4 -bg $x -text .t3.b4
+    set result {}
+    lappend result [testborder purple]
+    destroy .t2
+    lappend result [testborder purple]
+    destroy .b
+    lappend result [testborder purple]
+    destroy .t3
+    lappend result [testborder purple]
+    destroy .t
+    lappend result [testborder purple]
+} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+
+test border-4.1 {FreeBorderObjProc} {
+    destroy .b
+    set x [format purple]
+    button .b -bg $x -text .b1
+    set y [format purple]
+    .b configure -bg $y
+    set z [format purple]
+    .b configure -bg $z
+    set result {}
+    lappend result [testborder purple]
+    set x red
+    lappend result [testborder purple]
+    set z 32
+    lappend result [testborder purple]
+    destroy .b
+    lappend result [testborder purple]
+    set y bogus
+    set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+catch {destroy .b}
+button .b
+test get-2.1 {Tk_GetReliefFromObj} {
+    .b configure -relief flat
+    .b cget -relief
+} {flat}
+test get-2.2 {Tk_GetReliefFromObj} {
+    .b configure -relief groove
+    .b cget -relief
+} {groove}
+test get-2.3 {Tk_GetReliefFromObj} {
+    .b configure -relief raised
+    .b cget -relief
+} {raised}
+test get-2.3 {Tk_GetReliefFromObj} {
+    .b configure -relief ridge
+    .b cget -relief
+} {ridge}
+test get-2.3 {Tk_GetReliefFromObj} {
+    .b configure -relief solid
+    .b cget -relief
+} {solid}
+test get-2.3 {Tk_GetReliefFromObj} {
+    .b configure -relief sunken
+    .b cget -relief
+} {sunken}
+test get-2.4 {Tk_GetReliefFromObj - error} {
+    list [catch {.b configure -relief upanddown} msg] $msg
+} {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/bugs.tcl b/tests/bugs.tcl
index 880e216..e1492b4 100644
--- a/tests/bugs.tcl
+++ b/tests/bugs.tcl
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: bugs.tcl,v 1.2 1998/09/14 18:23:43 stanton Exp $
+# RCS: @(#) $Id: bugs.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $
 
 if {[info procs test] != "test"} {
     source defs
@@ -28,3 +28,16 @@ test crash-1.1 {color} {
     . configure -bg rgb:345
     set foo ""
 } {}
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/butGeom.tcl b/tests/butGeom.tcl
index 7f124df..da91d08 100644
--- a/tests/butGeom.tcl
+++ b/tests/butGeom.tcl
@@ -1,7 +1,7 @@
 # This file creates a visual test for button layout.  It is part of
 # the Tk visual test suite, which is invoked via the "visual" script.
 #
-# RCS: @(#) $Id: butGeom.tcl,v 1.2 1998/09/14 18:23:43 stanton Exp $
+# RCS: @(#) $Id: butGeom.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $
 
 catch {destroy .t}
 toplevel .t
@@ -113,3 +113,16 @@ proc config {option value} {
 	$w configure $option $value
     }
 }
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/butGeom2.tcl b/tests/butGeom2.tcl
index 36122ea..9dc223e 100644
--- a/tests/butGeom2.tcl
+++ b/tests/butGeom2.tcl
@@ -1,7 +1,7 @@
 # This file creates a visual test for button layout.  It is part of
 # the Tk visual test suite, which is invoked via the "visual" script.
 #
-# RCS: @(#) $Id: butGeom2.tcl,v 1.2 1998/09/14 18:23:43 stanton Exp $
+# RCS: @(#) $Id: butGeom2.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $
 
 catch {destroy .t}
 toplevel .t
@@ -111,3 +111,16 @@ proc config-but {option value} {
 	$w configure $option $value
     }
 }
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/button.test b/tests/button.test
index 1e36dd2..309c795 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -4,23 +4,23 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: button.test,v 1.2 1998/09/14 18:23:43 stanton Exp $
+# RCS: @(#) $Id: button.test,v 1.3 1999/04/16 01:51:34 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\""
     puts "image, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 foreach i [winfo children .] {
     destroy $i
 }
@@ -51,255 +51,217 @@ update
 set i 1
 foreach test {
     {-activebackground #012345 #012345 non-existent
-	    {unknown color name "non-existent"}}
+	    {unknown color name "non-existent"} {0 1 1 1}}
     {-activeforeground #ff0000 #ff0000 non-existent
-	    {unknown color name "non-existent"}}
-    {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
+	    {unknown color name "non-existent"} {0 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"}}
-    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
-    {-bd 4 4 badValue {bad screen distance "badValue"}}
-    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
-    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
-    {-command "set x" {set x} {} {}}
-    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
-    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
-    {-fg #110022 #110022 bogus {unknown color name "bogus"}}
-    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
-    {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
-    {-height 18 18 20.0 {expected integer but got "20.0"}}
-    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
-    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
-    {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
-    {-image image1 image1 bogus {image "bogus" doesn't exist}}
-    {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}
-    {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
-    {-offvalue lousy lousy {} {}}
-    {-offvalue fantastic fantastic {} {}}
-    {-padx 12 12 420x {bad screen distance "420x"}}
-    {-pady 12 12 420x {bad screen distance "420x"}}
-    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
-    {-selectimage image1 image1 bogus {image "bogus" doesn't exist}}
-    {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
-    {-takefocus "any string" "any string" {} {}}
-    {-text "Sample text" {Sample text} {} {}}
-    {-textvariable i i {} {}}
-    {-underline 5 5 3p {expected integer but got "3p"}}
-    {-width 402 402 3p {expected integer but got "3p"}}
-    {-wraplength 100 100 6x {bad screen distance "6x"}}
+	    {unknown color name "non-existent"} {1 1 1 1}}
+    {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}}
+    {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}
+	    {1 1 1 1}}
+    {-bitmap questhead questhead badValue {bitmap "badValue" not defined}
+	    {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}}
+    {-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}
+	    {0 1 0 0}}
+    {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}
+	    {0 1 1 1}}
+    {-fg #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
+    {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist} {1 1 1 1}}
+    {-foreground #110022 #110022 bogus {unknown color name "bogus"} {1 1 1 1}}
+    {-height 18 18 20.0 {expected integer but got "20.0"} {1 1 1 1}}
+    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}
+	    {1 1 1 1}}
+    {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}
+	    {1 1 1 1}}
+    {-highlightthickness 6m 6m badValue {bad screen distance "badValue"}
+	    {1 1 1 1}}
+    {-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}}
+    {-offvalue lousy lousy {} {} {0 0 1 0}}
+    {-offvalue fantastic fantastic {} {} {0 0 1 0}}
+    {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+    {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+    {-relief groove groove 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} {0 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}}
+    {-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]
-    test button-1.$i {configuration options} {
-	.c configure $name [lindex $test 1]
-	lindex [.c configure $name] 4
-    } [lindex $test 2]
-    incr i
-    if {[lindex $test 3] != ""} {
-	test button-1.$i {configuration options} {
-	    list [catch {.c configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    set classes [lindex $test 5]
+    foreach w {.l .b .c .r} hasOption [lindex $test 5] {
+	if $hasOption {
+	    test button-1.$i {configuration options} {
+		$w configure $name [lindex $test 1]
+		lindex [$w configure $name] 4
+	    } [lindex $test 2]
+	    incr i
+	    if {[lindex $test 3] != ""} {
+		test button-1.$i {configuration options} {
+		    list [catch {$w configure $name [lindex $test 3]} msg] $msg
+		} [list 1 [lindex $test 4]]
+	    }
+	    $w configure $name [lindex [$w configure $name] 3]
+	} else {
+	    test button-1.$i {configuration options} {
+		list [catch {$w configure $name [lindex $test 1]} msg] $msg
+	    } "1 {unknown option \"$name\"}"
+	}
     }
-    .c configure $name [lindex [.c configure $name] 3]
     incr i
 }
 test button-1.$i {configuration options} {
     .c configure -selectcolor {}
 } {}
 incr i
-# the following tests only work on buttons, not checkbuttons
-test button-1.$i {configuration options} {
-    .b configure -default active
-    lindex [.b configure -default] 4
-} active
-incr i
-test button-1.$i {configuration options} {
-    .b configure -default normal
-    lindex [.b configure -default] 4
-} normal
-incr i
-test button-1.$i {configuration options} {
-    .b configure -default disabled
-    lindex [.b configure -default] 4
-} disabled
-incr i
-test button-1.$i {configuration options} {
-    .b configure -default active
-    lindex [.b configure -default] 3
-} disabled
-incr i
-test button-1.$i {configuration options} {
-    list [catch {.b configure -default no_way} msg] $msg
-} {1 {bad -default value "no_way": must be normal, active, or disabled}}
 
-set i 1
-foreach check {
-    {-activebackground 1 0 0 0}
-    {-activeforeground 1 0 0 0}
-    {-anchor 0 0 0 0}
-    {-background 0 0 0 0}
-    {-bd 0 0 0 0}
-    {-bg 0 0 0 0}
-    {-bitmap 0 0 0 0}
-    {-borderwidth 0 0 0 0}
-    {-command 1 0 0 0}
-    {-cursor 0 0 0 0}
-    {-default 1 0 1 1}
-    {-disabledforeground 1 0 0 0}
-    {-fg 0 0 0 0}
-    {-font 0 0 0 0}
-    {-foreground 0 0 0 0}
-    {-height 0 0 0 0}
-    {-image 0 0 0 0}
-    {-indicatoron 1 1 0 0}
-    {-offvalue 1 1 0 1}
-    {-onvalue 1 1 0 1}
-    {-padx 0 0 0 0}
-    {-pady 0 0 0 0}
-    {-relief 0 0 0 0}
-    {-selectcolor 1 1 0 0}
-    {-selectimage 1 1 0 0}
-    {-state 1 0 0 0}
-    {-text 0 0 0 0}
-    {-textvariable 0 0 0 0}
-    {-value 1 1 1 0}
-    {-variable 1 1 0 0}
-    {-width 0 0 0 0}
+test button-3.1 {ButtonCreate - not enough cd ../unix
 } {
-    test button-2.$i {label-specific options} "
-	catch {.l configure [lindex $check 0]}
-    " [lindex $check 1]
-    incr i
-    test button-2.$i {button-specific options} "
-	catch {.b configure [lindex $check 0]}
-    " [lindex $check 2]
-    incr i
-    test button-2.$i {checkbutton-specific options} "
-	catch {.c configure [lindex $check 0]}
-    " [lindex $check 3]
-    incr i
-    test button-2.$i {radiobutton-specific options} "
-	catch {.r configure [lindex $check 0]}
-    " [lindex $check 4]
-    incr i
-}
-
-test button-3.1 {ButtonCreate procedure} {
     list [catch {button} msg] $msg
 } {1 {wrong # args: should be "button pathName ?options?"}}
-test button-3.2 {ButtonCreate procedure} {
+test button-3.2 {ButtonCreate procedure - setting label class} {
     catch {destroy .x}
     label .x
     winfo class .x
 } {Label}
-test button-3.3 {ButtonCreate procedure} {
+test button-3.3 {ButtonCreate - setting button class} {
     catch {destroy .x}
     button .x
     winfo class .x
 } {Button}
-test button-3.4 {ButtonCreate procedure} {
+test button-3.4 {ButtonCreate - setting checkbutton class} {
     catch {destroy .x}
     checkbutton .x
     winfo class .x
 } {Checkbutton}
-test button-3.5 {ButtonCreate procedure} {
+test button-3.5 {ButtonCreate - setting radiobutton class} {
     catch {destroy .x}
     radiobutton .x
     winfo class .x
 } {Radiobutton}
 rename button gorp
-test button-3.6 {ButtonCreate procedure} {
+test button-3.6 {ButtonCreate - setting class} {
     catch {destroy .x}
     gorp .x
     winfo class .x
 } {Button}
 rename gorp button
-test button-3.7 {ButtonCreate procedure} {
+test button-3.7 {ButtonCreate - bad window name} {
     list [catch {button foo} msg] $msg
 } {1 {bad window path name "foo"}}
-test button-3.8 {ButtonCreate procedure} {
+test button-3.8 {ButtonCreate procedure - error in default option value} {
+    catch {destroy .funny}
+    option add *funny.background bogus
+    list [catch {button .funny} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+    (database entry for "-background" in widget ".funny")
+    invoked from within
+"button .funny"}}
+test button-3.9 {ButtonCreate procedure - option error} {
     catch {destroy .x}
     list [catch {button .x -gorp foo} msg] $msg [winfo exists .x]
 } {1 {unknown option "-gorp"} 0}
+test button-3.10 {ButtonCreate procedure - return value} {
+    catch {destroy .abcd}
+    set x [button .abcd]
+    destroy .abc
+    set x
+} {.abcd}
 
-test button-4.1 {ButtonWidgetCmd procedure} {
+test button-4.1 {ButtonWidgetCmd - too few arguments} {
     list [catch {.b} msg] $msg
 } {1 {wrong # args: should be ".b option ?arg arg ...?"}}
-test button-4.2 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.2 {ButtonWidgetCmd - bad option name} {
     list [catch {.b c} msg] $msg
-} {1 {bad option "c": must be cget, configure, flash, or invoke}}
-test button-4.3 {ButtonWidgetCmd procedure, "cget" option} {
+} {1 {ambiguous option "c": must be cget, configure, flash, or invoke}}
+test button-4.3 {ButtonWidgetCmd - bad option name} {
+    list [catch {.b bogus} msg] $msg
+} {1 {bad option "bogus": must be cget, configure, flash, or invoke}}
+test button-4.4 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.b cget a b} msg] $msg
 } {1 {wrong # args: should be ".b cget option"}}
-test button-4.4 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.b cget -gorp} msg] $msg
 } {1 {unknown option "-gorp"}}
-test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
     .b configure -highlightthickness 3
     .b cget -highlightthickness
 } {3}
-test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.l cget -disabledforeground} msg] $msg
 } {1 {unknown option "-disabledforeground"}}
-test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
     catch {.b cget -disabledforeground}
 } {0}
-test button-4.8 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.b cget -variable} msg] $msg
 } {1 {unknown option "-variable"}}
-test button-4.9 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
     catch {.c cget -variable}
 } {0}
-test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.c cget -value} msg] $msg
 } {1 {unknown option "-value"}}
-test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
     catch {.r cget -value}
 } {0}
-test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.13 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.r cget -onvalue} msg] $msg
 } {1 {unknown option "-onvalue"}}
-test button-4.13 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
     llength [.c configure]
 } {36}
-test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
     list [catch {.b configure -gorp} msg] $msg
 } {1 {unknown option "-gorp"}}
-test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.16 {ButtonWidgetCmd procedure, "configure" option} {
     list [catch {.b co -bg #ffffff -fg} msg] $msg
 } {1 {value for "-fg" missing}}
-test button-4.16 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.17 {ButtonWidgetCmd procedure, "configure" option} {
     .b configure -fg #123456
     .b configure -bg #654321
     lindex [.b configure -fg] 4
 } {#123456}
 .c configure -variable value -onvalue 1 -offvalue 0
 .r configure -variable value2 -value red
-test button-4.17 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} {
     list [catch {.c deselect foo} msg] $msg
 } {1 {wrong # args: should be ".c deselect"}}
-test button-4.18 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} {
     list [catch {.l deselect} msg] $msg
 } {1 {bad option "deselect": must be cget or configure}}
-test button-4.19 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} {
     list [catch {.b deselect} msg] $msg
 } {1 {bad option "deselect": must be cget, configure, flash, or invoke}}
-test button-4.20 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
     set value 1
     .c d
     set value
 } {0}
-test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
     set value2 green
     .r deselect
     set value2
 } {green}
-test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
     set value2 red
     .r deselect
     set value2
 } {}
-test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
     set value 1
     trace variable value w bogusTrace
     set result [list [catch {.c deselect} msg] $msg $errorInfo $value]
@@ -308,7 +270,7 @@ test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
 } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
     while executing
 ".c deselect"} 0}
-test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.25 {ButtonWidgetCmd procedure, "deselect" option} {
     set value2 red
     trace variable value2 w bogusTrace
     set result [list [catch {.r deselect} msg] $msg $errorInfo $value2]
@@ -317,40 +279,40 @@ test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
 } {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
     while executing
 ".r deselect"} {}}
-test button-4.25 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.26 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.b flash foo} msg] $msg
 } {1 {wrong # args: should be ".b flash"}}
-test button-4.26 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.27 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.l flash} msg] $msg
 } {1 {bad option "flash": must be cget or configure}}
-test button-4.27 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.b flash} msg] $msg
 } {0 {}}
-test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.c flash} msg] $msg
 } {0 {}}
-test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.30 {ButtonWidgetCmd procedure, "flash" option} {
     list [catch {.r f} msg] $msg
 } {0 {}}
-test button-4.30 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} {
     list [catch {.b invoke foo} msg] $msg
 } {1 {wrong # args: should be ".b invoke"}}
-test button-4.31 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} {
     list [catch {.l invoke} msg] $msg
 } {1 {bad option "invoke": must be cget or configure}}
-test button-4.32 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} {
     .b configure -command {set x invoked}
     set x "not invoked"
     .b invoke
     set x
 } {invoked}
-test button-4.33 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
     .b configure -command {set x invoked} -state disabled
     set x "not invoked"
     .b invoke
     set x
 } {not invoked}
-test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
     set value bogus
     .c configure -command {set x invoked} -variable value -onvalue 1 \
 	    -offvalue 0
@@ -358,35 +320,35 @@ test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
     .c invoke
     list $x $value
 } {invoked 1}
-test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.36 {ButtonWidgetCmd procedure, "invoke" option} {
     set value2 green
     .r configure -command {set x invoked} -variable value2 -value red
     set x "not invoked"
     .r i
     list $x $value2
 } {invoked red}
-test button-4.36 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.37 {ButtonWidgetCmd procedure, "select" option} {
     list [catch {.l select} msg] $msg
 } {1 {bad option "select": must be cget or configure}}
-test button-4.37 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.38 {ButtonWidgetCmd procedure, "select" option} {
     list [catch {.b select} msg] $msg
 } {1 {bad option "select": must be cget, configure, flash, or invoke}}
-test button-4.38 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.39 {ButtonWidgetCmd procedure, "select" option} {
     list [catch {.c select foo} msg] $msg
 } {1 {wrong # args: should be ".c select"}}
-test button-4.39 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.40 {ButtonWidgetCmd procedure, "select" option} {
     set value bogus
     .c configure -command {} -variable value -onvalue lovely -offvalue 0
     .c s
     set value
 } {lovely}
-test button-4.40 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
     set value2 green
     .r configure -command {} -variable value2 -value red
     .r select
     set value2
 } {red}
-test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
+test button-4.42 {ButtonWidgetCmd procedure, "select" option} {
     set value2 yellow
     trace variable value2 w bogusTrace
     set result [list [catch {.r select} msg] $msg $errorInfo $value2]
@@ -395,19 +357,19 @@ test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
 } {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
     while executing
 ".r select"} red}
-test button-4.42 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} {
     list [catch {.l toggle} msg] $msg
 } {1 {bad option "toggle": must be cget or configure}}
-test button-4.43 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} {
     list [catch {.b toggle} msg] $msg
 } {1 {bad option "toggle": must be cget, configure, flash, or invoke}}
-test button-4.44 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} {
     list [catch {.r toggle} msg] $msg
 } {1 {bad option "toggle": must be cget, configure, deselect, flash, invoke, or select}}
-test button-4.45 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
     list [catch {.c toggle foo} msg] $msg
 } {1 {wrong # args: should be ".c toggle"}}
-test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
     set value bogus
     .c configure -command {} -variable value -onvalue sunshine -offvalue rain
     .c toggle
@@ -417,7 +379,7 @@ test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
     .c toggle
     lappend result $value
 } {sunshine rain sunshine}
-test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
     .c configure -onvalue xyz -offvalue abc
     set value xyz
     trace variable value w bogusTrace
@@ -427,7 +389,7 @@ test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
 } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
     while executing
 ".c toggle"} abc}
-test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} {
     .c configure -onvalue xyz -offvalue abc
     set value abc
     trace variable value w bogusTrace
@@ -437,9 +399,6 @@ test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
 } {1 {can't set "value": trace aborted} {can't set "value": trace aborted
     while executing
 ".c toggle"} xyz}
-test button-4.49 {ButtonWidgetCmd procedure} {
-    list [catch {.c bad_option} msg] $msg
-} {1 {bad option "bad_option": must be cget, configure, deselect, flash, invoke, select, or toggle}}
 test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
     catch {unset value}; set value(1) 1;
     set result [list [catch {.c toggle} msg] $msg $errorInfo]
@@ -462,7 +421,14 @@ test button-5.1 {DestroyButton procedure} {
     eval destroy [winfo children .]
 } {}
 
-test button-6.1 {ConfigureButton procedure} {
+test button-6.1 {ConfigureButton - textvariable trace} {
+    catch {destroy .b1}
+    button .b1 -bd 4 -bg green
+    catch {.b1 configure -bd 7 -bg green -fg bogus}
+    list [catch {.b1 configure -bd 7 -bg red -fg bogus} msg] \
+	    $msg [.b1 cget -bd] [.b1 cget -bg]
+} {1 {unknown color name "bogus"} 4 green}
+test button-6.2 {ConfigureButton - textvariable trace} {
     catch {destroy .b1}
     set x From-x
     set y From-y
@@ -471,7 +437,7 @@ test button-6.1 {ConfigureButton procedure} {
     set x New
     lindex [.b1 configure -text] 4
 } {From-y}
-test button-6.2 {ConfigureButton procedure} {
+test button-6.2 {ConfigureButton - variable traces} {
     catch {destroy .b1}
     catch {unset x}
     checkbutton .b1 -variable x
@@ -482,7 +448,7 @@ test button-6.2 {ConfigureButton procedure} {
     .b1 toggle
     set y
 } {1}
-test button-6.3 {ConfigureButton procedure} {
+test button-6.3 {ConfigureButton - image handling} {
     catch {destroy .b1}
     eval image delete [image names]
     image create test image1
@@ -492,18 +458,12 @@ test button-6.3 {ConfigureButton procedure} {
     .b1 configure -image image2
     image names
 } {image2}
-test button-6.4 {ConfigureButton procedure} {
-    catch {destroy .b1}
-    button .b1 -text "Test" -state disabled
-    list [catch {.b1 configure -state bogus} msg] $msg \
-	    [lindex [.b1 configure -state] 4]
-} {1 {bad state value "bogus": must be normal, active, or disabled} normal}
-test button-6.5 {ConfigureButton procedure} {
+test button-6.5 {ConfigureButton - default value for variable} {
     catch {destroy .b1}
     checkbutton .b1
     .b1 cget -variable
 } {b1}
-test button-6.6 {ConfigureButton procedure} {
+test button-6.6 {ConfigureButton - setting selected state from variable} {
     catch {destroy .b1}
     set x 0
     set y Shiny
@@ -512,19 +472,19 @@ test button-6.6 {ConfigureButton procedure} {
     .b1 toggle
     set y
 } 0
-test button-6.7 {ConfigureButton procedure} {
+test button-6.7 {ConfigureButton - setting selected state from variable} {
     catch {destroy .b1}
     catch {unset x}
     checkbutton .b1 -variable x -offvalue Bogus
     set x
 } Bogus
-test button-6.8 {ConfigureButton procedure} {
+test button-6.8 {ConfigureButton - setting selected state from variable} {
     catch {destroy .b1}
     catch {unset x}
     radiobutton .b1 -variable x
     set x
 } {}
-test button-6.9 {ConfigureButton procedure} {
+test button-6.9 {ConfigureButton - error in setting variable} {
     catch {destroy .b1}
     catch {unset x}
     trace variable x w bogusTrace
@@ -532,23 +492,23 @@ test button-6.9 {ConfigureButton procedure} {
     trace vdelete x w bogusTrace
     set result
 } {1 {can't set "x": trace aborted}}
-test button-6.10 {ConfigureButton procedure} {
+test button-6.10 {ConfigureButton - bad image name} {
     catch {destroy .b1}
     list [catch {button .b1 -image bogus} msg] $msg
 } {1 {image "bogus" doesn't exist}}
-test button-6.11 {ConfigureButton procedure} {
+test button-6.11 {ConfigureButton - setting variable from current text value} {
     catch {destroy .b1}
     catch {unset x}
     button .b1 -textvariable x -text "Button 1"
     set x
 } {Button 1}
-test button-6.12 {ConfigureButton procedure} {
+test button-6.12 {ConfigureButton - using current value of variable} {
     catch {destroy .b1}
     set x Override
     button .b1 -textvariable x -text "Button 1"
     set x
 } {Override}
-test button-6.13 {ConfigureButton procedure} {
+test button-6.13 {ConfigureButton - variable handling} {
     catch {destroy .b1}
     catch {unset x}
     trace variable x w bogusTrace
@@ -557,7 +517,7 @@ test button-6.13 {ConfigureButton procedure} {
     trace vdelete x w bogusTrace
     set result
 } {1 {can't set "x": trace aborted} foo}
-test button-6.14 {ConfigureButton procedure} {
+test button-6.14 {ConfigureButton - -width option} {
     catch {destroy .b1}
     button .b1 -text "Button 1"
     list [catch {.b1 configure -width 1i} msg] $msg $errorInfo
@@ -565,7 +525,7 @@ test button-6.14 {ConfigureButton procedure} {
     (processing -width option)
     invoked from within
 ".b1 configure -width 1i"}}
-test button-6.15 {ConfigureButton procedure} {
+test button-6.15 {ConfigureButton - -height option} {
     catch {destroy .b1}
     button .b1 -text "Button 1"
     list [catch {.b1 configure -height 0.5c} msg] $msg $errorInfo
@@ -573,7 +533,7 @@ test button-6.15 {ConfigureButton procedure} {
     (processing -height option)
     invoked from within
 ".b1 configure -height 0.5c"}}
-test button-6.16 {ConfigureButton procedure} {
+test button-6.16 {ConfigureButton - -width option} {
     catch {destroy .b1}
     button .b1 -bitmap questhead
     list [catch {.b1 configure -width abc} msg] $msg $errorInfo
@@ -581,7 +541,7 @@ test button-6.16 {ConfigureButton procedure} {
     (processing -width option)
     invoked from within
 ".b1 configure -width abc"}}
-test button-6.17 {ConfigureButton procedure} {
+test button-6.17 {ConfigureButton - -height option} {
     catch {destroy .b1}
     eval image delete [image names]
     image create test image1
@@ -591,7 +551,7 @@ test button-6.17 {ConfigureButton procedure} {
     (processing -height option)
     invoked from within
 ".b1 configure -height 0.5x"}}
-test button-6.18 {ConfigureButton procedure} {nonPortable fonts} {
+test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} {
     catch {destroy .b1}
     button .b1 -text "Sample text" -width 10 -height 2
     pack .b1
@@ -599,7 +559,7 @@ test button-6.18 {ConfigureButton procedure} {nonPortable fonts} {
     .b1 configure -bitmap questhead
     lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
 } {102 46 20 12}
-test button-6.19 {ConfigureButton procedure} {
+test button-6.19 {ConfigureButton - computing geometry} {
     catch {destroy .b1}
     button .b1 -text "Button 1"
     set old [winfo reqwidth .b1]
@@ -820,3 +780,19 @@ eval destroy [winfo children .]
 
 option clear
 
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvImg.test b/tests/canvImg.test
index 05af9df..a79c15e 100644
--- a/tests/canvImg.test
+++ b/tests/canvImg.test
@@ -4,23 +4,23 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: canvImg.test,v 1.2 1998/09/14 18:23:43 stanton Exp $
+# RCS: @(#) $Id: canvImg.test,v 1.3 1999/04/16 01:51:34 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 foreach i [winfo children .] {
     destroy $i
 }
@@ -395,3 +395,20 @@ test canvImg-11.3 {ImageChangedProc procedure} {
     update
     set y
 } {{foo2 display 0 0 20 40 50 40}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvPs.test b/tests/canvPs.test
index 6fc4bd0..08d72cf 100644
--- a/tests/canvPs.test
+++ b/tests/canvPs.test
@@ -3,14 +3,13 @@
 # TkCanvPostscriptCmd in generic/tkCanvPs.c
 #
 # Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: canvPs.test,v 1.2 1998/09/14 18:23:43 stanton Exp $
+# RCS: @(#) $Id: canvPs.test,v 1.3 1999/04/16 01:51:34 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -95,11 +94,24 @@ test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} {
     set status
 } ok
 
-# Clean-up
-
+# cleanup
 removeFile foo.ps
 removeFile bar.ps
-
 foreach i [winfo children .] {
     destroy $i
 }
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvPsArc.tcl b/tests/canvPsArc.tcl
index 8b77091..4acdbbe 100644
--- a/tests/canvPsArc.tcl
+++ b/tests/canvPsArc.tcl
@@ -2,7 +2,7 @@
 # for bitmaps in canvases.  It is part of the Tk visual test suite,
 # which is invoked via the "visual" script.
 #
-# RCS: @(#) $Id: canvPsArc.tcl,v 1.2 1998/09/14 18:23:44 stanton Exp $
+# RCS: @(#) $Id: canvPsArc.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
 catch {destroy .t}
 toplevel .t
@@ -43,3 +43,16 @@ $c create arc .5i 4.5i 2i 6i -style arc -start 135 -extent 315 -width 3m \
     -outline black -outlinestipple gray25
 $c create arc 3.5i 4.5i 5.5i 5.5i -style arc -start 45 -extent -90 -width 1m \
     -outline black
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvPsBmap.tcl b/tests/canvPsBmap.tcl
index 15f41a4..dbc9c83 100644
--- a/tests/canvPsBmap.tcl
+++ b/tests/canvPsBmap.tcl
@@ -2,7 +2,7 @@
 # for bitmaps in canvases.  It is part of the Tk visual test suite,
 # which is invoked via the "visual" script.
 #
-# RCS: @(#) $Id: canvPsBmap.tcl,v 1.2 1998/09/14 18:23:44 stanton Exp $
+# RCS: @(#) $Id: canvPsBmap.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
 catch {destroy .t}
 toplevel .t
@@ -69,3 +69,16 @@ $c create bitmap 5.5i 5.5i \
     -bitmap @[file join $tk_library demos/images/flagup.bmp] \
     -background {} -foreground black -anchor se
 $c create rect 5.47i 5.47i 5.53i 5.53i -fill {} -outline black
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvPsGrph.tcl b/tests/canvPsGrph.tcl
index 8458727..1b27898 100644
--- a/tests/canvPsGrph.tcl
+++ b/tests/canvPsGrph.tcl
@@ -2,7 +2,7 @@
 # for some of the graphical objects in canvases.  It is part of the Tk
 # visual test suite, which is invoked via the "visual" script.
 #
-# RCS: @(#) $Id: canvPsGrph.tcl,v 1.2 1998/09/14 18:23:44 stanton Exp $
+# RCS: @(#) $Id: canvPsGrph.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
 catch {destroy .t}
 toplevel .t
@@ -85,3 +85,16 @@ proc mkObjs c {
 }
 
 mkObjs $c
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvPsText.tcl b/tests/canvPsText.tcl
index 61df240..145dcc7 100644
--- a/tests/canvPsText.tcl
+++ b/tests/canvPsText.tcl
@@ -2,7 +2,7 @@
 # for text in canvases.  It is part of the Tk visual test suite,
 # which is invoked via the "visual" script.
 #
-# RCS: @(#) $Id: canvPsText.tcl,v 1.2 1998/09/14 18:23:44 stanton Exp $
+# RCS: @(#) $Id: canvPsText.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
 catch {destroy .t}
 toplevel .t
@@ -81,3 +81,16 @@ proc setStipple c {
     global stipple
     $c itemconfigure text -stipple $stipple
 }
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvRect.test b/tests/canvRect.test
index c582990..9ba8c8d 100644
--- a/tests/canvRect.test
+++ b/tests/canvRect.test
@@ -3,14 +3,13 @@
 # in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: canvRect.test,v 1.2 1998/09/14 18:23:44 stanton Exp $
+# RCS: @(#) $Id: canvRect.test,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -294,7 +293,7 @@ test canvRect-10.1 {TranslateRectOval procedure} {
 # This test is non-portable because different color information
 # will get generated on different displays (e.g. mono displays
 # vs. color).
-test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable win32sCrash macCrash} {
+test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable macCrash} {
     # Crashes on Mac because the XGetImage() call isn't implemented, causing a
     # dereference of NULL.
     
@@ -327,3 +326,20 @@ restore showpage
 end
 %%EOF
 }
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvText.test b/tests/canvText.test
index 9263e87..f0d9b85 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -3,14 +3,13 @@
 # fashion for Tcl tests.
 #
 # Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: canvText.test,v 1.3 1998/10/16 00:46:19 rjohnson Exp $
+# RCS: @(#) $Id: canvText.test,v 1.4 1999/04/16 01:51:35 stanton Exp $
 
-if {"[info procs test]" != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -174,7 +173,7 @@ test canvText-5.1 {ConfigureText procedure: adjust cursor} {
     .c delete x
 } {}
 
-test canvText-6.1 {ComputeTextBbox procedure} {fonts} {
+test canvText-6.1 {ComputeTextBbox procedure} {fonts nonPortable} {
     .c itemconfig test -font $font -text 0
     .c coords test 0 0
     set x {}
@@ -200,7 +199,7 @@ test canvText-6.1 {ComputeTextBbox procedure} {fonts} {
 focus .c
 .c focus test
 .c itemconfig test -text "abcd\nefghi\njklmnopq"
-test canvText-7.1 {DisplayText procedure: stippling} {
+test canvText-7.0 {DisplayText procedure: stippling} {
     .c itemconfig test -stipple gray50
     update
     .c itemconfig test -stipple {}
@@ -491,3 +490,19 @@ restore showpage
 end
 %%EOF
 "
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvWind.test b/tests/canvWind.test
index 2ae6ac8..76db55c 100644
--- a/tests/canvWind.test
+++ b/tests/canvWind.test
@@ -3,14 +3,13 @@
 # fashion for Tcl tests.
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: canvWind.test,v 1.2 1998/09/14 18:23:44 stanton Exp $
+# RCS: @(#) $Id: canvWind.test,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
-if {"[info procs test]" != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -131,3 +130,21 @@ test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} {
     update
     lappend x [list [winfo ismapped $f] [winfo x $f]]
 } {{1 3} {1 -79} {0 -79} {1 255} {0 255}}
+catch {destroy .t}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/canvas.test b/tests/canvas.test
index c37a36a..ee612ef 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -3,15 +3,13 @@
 # standard fashion for Tcl tests.
 #
 # Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: canvas.test,v 1.4 1998/10/13 18:13:07 rjohnson Exp $
+# RCS: @(#) $Id: canvas.test,v 1.5 1999/04/16 01:51:35 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -75,7 +73,16 @@ canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \
 	-highlightthickness 0
 pack .c
 update
-test canvas-2.1 {CanvasWidgetCmd, xview option} {
+
+test canvas-2.1 {CanvasWidgetCmd, bind option} {
+    set i [.c create rect 10 10 100 100]
+    list [catch {.c bind $i <a>} msg] $msg
+} {0 {}}
+test canvas-2.2 {CanvasWidgetCmd, bind option} {
+    set i [.c create rect 10 10 100 100]
+    list [catch {.c bind $i <} msg] $msg
+} {1 {no event type or button # or keysym}}
+test canvas-2.3 {CanvasWidgetCmd, xview option} {
     .c configure -xscrollincrement 40 -yscrollincrement 5
     .c xview moveto 0
     update
@@ -84,7 +91,7 @@ test canvas-2.1 {CanvasWidgetCmd, xview option} {
     update
     lappend x [.c xview]
 } {{0 0.3} {0.4 0.7}}
-test canvas-2.2 {CanvasWidgetCmd, xview option} {nonPortable} {
+test canvas-2.4 {CanvasWidgetCmd, xview option} {nonPortable} {
     # This test gives slightly different results on platforms such
     # as NetBSD.  I don't know why...
     .c configure -xscrollincrement 0 -yscrollincrement 5
@@ -236,3 +243,20 @@ test canvas-9.1 {canvas id creation and deletion} {
 	
     set x ""
 } {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/clipboard.test b/tests/clipboard.test
index 1c1b43b..7e482e9 100644
--- a/tests/clipboard.test
+++ b/tests/clipboard.test
@@ -3,19 +3,18 @@
 # fashion for Tcl tests.
 #
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: clipboard.test,v 1.2 1998/09/14 18:23:45 stanton Exp $
+# RCS: @(#) $Id: clipboard.test,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
 #
 # Note: Multiple display clipboard handling will only be tested if the
 # environment variable TK_ALT_DISPLAY is set to an alternate display.
 #
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 eval destroy [winfo child .]
@@ -232,3 +231,20 @@ test clipboard-7.13 {Tk_ClipboardCmd procedure} {
 test clipboard-7.14 {Tk_ClipboardCmd procedure} {
     list [catch {clipboard error} msg] $msg
 } {1 {bad option "error": must be clear or append}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/clrpick.test b/tests/clrpick.test
index a56b6b3..db101b8 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -2,22 +2,27 @@
 # It is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: clrpick.test,v 1.2 1998/09/14 18:23:45 stanton Exp $
+# RCS: @(#) $Id: clrpick.test,v 1.3 1999/04/16 01:51:35 stanton Exp $
 #
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
+# Some tests require user interaction on non-unix platform
+
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+    [expr {$::tcltest::testConfig(userInteraction) || \
+	$::tcltest::testConfig(unixOnly)}]
+
 test clrpick-1.1 {tk_chooseColor command} {
     list [catch {tk_chooseColor -foo} msg] $msg
-} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}}
+} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
 
-catch {tk_chooseColor -foo} msg
+catch {tk_chooseColor -foo 1} msg
 regsub -all ,      $msg "" options
 regsub \"-foo\" $options "" options
 
@@ -31,7 +36,7 @@ foreach option $options {
 
 test clrpick-1.3 {tk_chooseColor command} {
     list [catch {tk_chooseColor -foo bar} msg] $msg
-} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}}
+} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
 
 test clrpick-1.4 {tk_chooseColor command} {
     list [catch {tk_chooseColor -initialcolor} msg] $msg
@@ -55,14 +60,6 @@ if {[info commands tkColorDialog] == ""} {
     set isNative 0
 }
 
-if {$isNative && ![info exists INTERACTIVE]} {
-    puts " Some tests were skipped because they could not be performed"
-    puts " automatically on this platform. If you wish to execute them"
-    puts " interactively, set the TCL variable INTERACTIVE and re-run"
-    puts " the test."
-    return
-}
-
 proc ToPressButton {parent btn} {
     global isNative
     if {!$isNative} {
@@ -141,8 +138,9 @@ set verylongstring $verylongstring$verylongstring
 
 # let's soak up a bunch of colors...so that
 # machines with small color palettes still fail.
+# some tests will be skipped if there are no more colors
 set numcolors 32
-set nomorecolors 0
+set ::tcltest::testConfig(colorsLeftover) 1
 set i 0
 canvas .c
 pack .c -expand 1 -fill both
@@ -160,7 +158,7 @@ while {$i<$numcolors} {
 	set g [expr $g/256]
 	set b [expr $b/256]
 	if {"$color" != "#[format %02x%02x%02x $r $g $b]"} {
-	    set nomorecolors 1
+	    set ::tcltest::testConfig(colorsLeftover) 0
 	}
     }
     .c delete $i
@@ -169,47 +167,62 @@ while {$i<$numcolors} {
 
 destroy .c
 
-if {!$nomorecolors} {
-    set color #404040
-    test clrpick-2.1 {tk_chooseColor command} {
-	ToPressButton $parent ok
-	tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color -parent $parent
-    } "$color"
+set color #404040
+test clrpick-2.1 {tk_chooseColor command} \
+	{nonUnixUserInteraction colorsLeftover} {
+    ToPressButton $parent ok
+    tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color \
+	    -parent $parent
+} "$color"
     
-    set color #808040
-    test clrpick-2.2 {tk_chooseColor command} {
-	if {$tcl_platform(platform) == "macintosh"} {
-	    set colors "32768 32768 16384"
-	} else {
-	    set colors "128 128 64"
-	}
-	ToChooseColorByKey $parent 128 128 64
-	tk_chooseColor -parent $parent -title "choose $colors"
-    } "$color"
+set color #808040
+test clrpick-2.2 {tk_chooseColor command} \
+	{nonUnixUserInteraction colorsLeftover} {
+    if {$tcl_platform(platform) == "macintosh"} {
+	set colors "32768 32768 16384"
+    } else {
+	set colors "128 128 64"
+    }
+    ToChooseColorByKey $parent 128 128 64
+    tk_chooseColor -parent $parent -title "choose $colors"
+} "$color"
     
-    test clrpick-2.3 {tk_chooseColor command} {
-	ToPressButton $parent ok
-	tk_chooseColor -parent $parent -title "Press OK"
-    } "$color"
-} else {
-    puts "Skipped tests clrpick2.1, clrpick2.2 and clrpick2.3 because"
-    puts "you ran out of colors in your color palette, and this would"
-    puts "have caused the tests to generate errors."
-}
+test clrpick-2.3 {tk_chooseColor command} \
+	{nonUnixUserInteraction colorsLeftover} {
+    ToPressButton $parent ok
+    tk_chooseColor -parent $parent -title "Press OK"
+} "$color"
     
-test clrpick-2.4 {tk_chooseColor command} {
+test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} {
     ToPressButton $parent cancel
     tk_chooseColor -parent $parent -title "Press Cancel"
 } ""
 
 set color #000000
-test clrpick-3.1 {tk_chooseColor: background events} {
+test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} {
     after 1 {set x 53}
     ToPressButton $parent ok
     tk_chooseColor -parent $parent -title "Press OK" -initialcolor $color
 } "#000000"
-test clrpick-3.2 {tk_chooseColor: background events} {
+test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} {
     after 1 {set x 53}
     ToPressButton $parent cancel
     tk_chooseColor -parent $parent -title "Press Cancel"
 } ""
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/cmap.tcl b/tests/cmap.tcl
index fb92643..dca7f71 100644
--- a/tests/cmap.tcl
+++ b/tests/cmap.tcl
@@ -2,7 +2,7 @@
 # property.  It is part of the Tk visual test suite, which is invoked
 # via the "visual" script.
 #
-# RCS: @(#) $Id: cmap.tcl,v 1.2 1998/09/14 18:23:45 stanton Exp $
+# RCS: @(#) $Id: cmap.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
 catch {destroy .t}
 toplevel .t -colormap new
@@ -59,3 +59,16 @@ pack .t2.quit -side bottom -pady 3 -ipadx 4 -ipady 2
 frame .t2.f -height 320 -width 320
 pack .t2.f -side bottom
 colors .t2.f 0 0 4
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/cmds.test b/tests/cmds.test
index 6524f3c..c6301d9 100644
--- a/tests/cmds.test
+++ b/tests/cmds.test
@@ -2,14 +2,13 @@
 # tkCmds.c.  It is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: cmds.test,v 1.2 1998/09/14 18:23:45 stanton Exp $
+# RCS: @(#) $Id: cmds.test,v 1.3 1999/04/16 01:51:35 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 eval destroy [winfo child .]
@@ -41,3 +40,20 @@ test cmds-1.5 {tkwait visibility, window gets deleted} {
     after 100 {set x deleted; destroy .f}
     list [catch {tkwait visibility .f.b} msg] $msg $x
 } {1 {window ".f.b" was deleted before its visibility changed} deleted}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/color.test b/tests/color.test
index 7c68ec3..3b86efc 100644
--- a/tests/color.test
+++ b/tests/color.test
@@ -1,15 +1,20 @@
 # This file is a Tcl script to test out the procedures in the file
 # tkColor.c.  It is organized in the standard fashion for Tcl tests.
 #
-# Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1995-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: color.test,v 1.2 1998/09/14 18:23:45 stanton Exp $
+# RCS: @(#) $Id: color.test,v 1.3 1999/04/16 01:51:36 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
-if {[info procs test] != "test"} {
-    source defs
+if {[info commands testcolor] != "testcolor"} {
+    puts "testcolor command not available; skipping tests"
+    ::tcltest::cleanupTests
+    return
 }
 
 eval destroy [winfo children .]
@@ -103,11 +108,13 @@ proc colorsFree {w {red 31} {green 245} {blue 192}} {
 # test file.
 
 if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] {
+    ::tcltest::cleanupTests
     return
 }
 wm geom .t +0+0
 if {[winfo depth .t] != 8} {
     destroy .t
+    ::tcltest::cleanupTests
     return
 }
 mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40
@@ -115,31 +122,75 @@ pack .t.c
 update
 if ![colorsFree .t.c 101 233 17] {
     destroy .t
+    ::tcltest::cleanupTests
     return
 }
 mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
 pack .t.c2
 if [colorsFree .t.c] {
     destroy .t
+    ::tcltest::cleanupTests
     return
 }
 destroy .t.c .t.c2
 
-test color-1.1 {Tk_GetColor procedure} {
-    c255 [winfo rgb .t red]
+test color-1.1 {Tk_AllocColorFromObj - converting internal reps} {
+    set x green
+    lindex $x 0
+    destroy .b1
+    button .b1 -foreground $x -text .b1
+    lindex $x 0
+    testcolor green
+} {{1 0}}
+test color-1.2 {Tk_AllocColorFromObj - discard stale color} {
+    set x green
+    destroy .b1 .b2
+    button .b1 -foreground $x -text First
+    destroy .b1
+    set result {}
+    lappend result [testcolor green]
+    button .b2 -foreground $x -text Second
+    lappend result [testcolor green]
+} {{} {{1 1}}}
+test color-1.3 {Tk_AllocColorFromObj - reuse existing color} {
+    set x green
+    destroy .b1 .b2
+    button .b1 -foreground $x -text First
+    set result {}
+    lappend result [testcolor green]
+    button .b2 -foreground $x -text Second
+    pack .b1 .b2 -side top
+    lappend result [testcolor green]
+} {{{1 1}} {{2 1}}}
+test color-1.4 {Tk_AllocColorFromObj - try other colors in list} {
+    set x purple
+    destroy .b1 .b2 .t.b
+    button .b1 -foreground $x -text First
+    pack .b1 -side top
+    set result {}
+    lappend result [testcolor purple]
+    button .t.b -foreground $x -text Second
+    pack .t.b -side top
+    lappend result [testcolor purple]
+    button .b2 -foreground $x -text Third
+    pack .b2 -side top
+    lappend result [testcolor purple]
+} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}
+
+test color-2.1 {Tk_GetColor procedure} {
+    c255 [winfo rgb .t #FF0000]
 } {255 0 0}
-test color-1.2 {Tk_GetColor procedure} {
+test color-2.2 {Tk_GetColor procedure} {
     list [catch {winfo rgb .t noname} msg] $msg
 } {1 {unknown color name "noname"}}
-
-test color-1.3 {Tk_GetColor procedure} {
+test color-2.3 {Tk_GetColor procedure} {
     c255 [winfo rgb .t #123456]
 } {18 52 86}
-test color-1.4 {Tk_GetColor procedure} {
+test color-2.4 {Tk_GetColor procedure} {
     list [catch {winfo rgb .t #xyz} msg] $msg
 } {1 {invalid color name "#xyz"}}
 
-test color-2.1 {Tk_FreeColor procedure, reference counting} {
+test color-3.1 {Tk_FreeColor procedure, reference counting} {
     eval destroy [winfo child .t]
     mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
     pack .t.c
@@ -153,7 +204,7 @@ test color-2.1 {Tk_FreeColor procedure, reference counting} {
     .t.c2 delete $last
     lappend result [colorsFree .t]
 } {0 1}
-test color-2.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
+test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
     eval destroy [winfo child .t]
     mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
     pack .t.c
@@ -163,5 +214,86 @@ test color-2.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
     update
     closest .t 241 241 1
 } {240 240 0}
+test color-3.3 {Tk_FreeColorFromObj - reference counts} {
+    set x purple
+    destroy .b1 .b2 .t.b
+    button .b1 -foreground $x -text First
+    pack .b1 -side top
+    button .t.b -foreground $x -text Second
+    pack .t.b -side top
+    button .b2 -foreground $x -text Third
+    pack .b2 -side top
+    set result {}
+    lappend result [testcolor purple]
+    destroy .b1
+    lappend result [testcolor purple]
+    destroy .b2
+    lappend result [testcolor purple]
+    destroy .t.b
+    lappend result [testcolor purple]
+} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
+test color-3.4 {Tk_FreeColorFromObj - unlinking from list} {
+    destroy .b .t.b .t2 .t3
+    toplevel .t2 -visual {pseudocolor 8} -colormap new
+    toplevel .t3 -visual {pseudocolor 8} -colormap new
+    set x purple
+    button .b -foreground $x -text .b1
+    button .t.b1 -foreground $x -text .t.b1
+    button .t.b2 -foreground $x -text .t.b2
+    button .t2.b1 -foreground $x -text .t2.b1
+    button .t2.b2 -foreground $x -text .t2.b2
+    button .t2.b3 -foreground $x -text .t2.b3
+    button .t3.b1 -foreground $x -text .t3.b1
+    button .t3.b2 -foreground $x -text .t3.b2
+    button .t3.b3 -foreground $x -text .t3.b3
+    button .t3.b4 -foreground $x -text .t3.b4
+    set result {}
+    lappend result [testcolor purple]
+    destroy .t2
+    lappend result [testcolor purple]
+    destroy .b
+    lappend result [testcolor purple]
+    destroy .t3
+    lappend result [testcolor purple]
+    destroy .t
+    lappend result [testcolor purple]
+} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+
+test color-4.1 {FreeColorObjProc} {
+    destroy .b
+    set x [format purple]
+    button .b -foreground $x -text .b1
+    set y [format purple]
+    .b configure -foreground $y
+    set z [format purple]
+    .b configure -foreground $z
+    set result {}
+    lappend result [testcolor purple]
+    set x red
+    lappend result [testcolor purple]
+    set z 32
+    lappend result [testcolor purple]
+    destroy .b
+    lappend result [testcolor purple]
+    set y bogus
+    set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
 
 destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/config.test b/tests/config.test
new file mode 100644
index 0000000..8fdbbd7
--- /dev/null
+++ b/tests/config.test
@@ -0,0 +1,839 @@
+# This file is a Tcl script to test the procedures in tkConfig.c,
+# which comprise the new new option configuration system.  It is
+# organized in the standard "white-box" fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: config.test,v 1.2 1999/04/16 01:51:36 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info command testobjconfig] != "testobjconfig"} {
+    puts "This application hasn't been compiled with the \"testobjconfig\""
+    puts "command, so I can't run this test.  Are you sure you're using"
+    puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
+    return
+}
+
+proc killTables {} {
+    # Note: it's important to delete chain2 before chain1, because
+    # chain2 depends on chain1.  If chain1 is deleted first, the
+    # delete of chain2 will crash.
+
+    foreach t {alltypes chain2 chain1 configerror internal new notenoughparams
+	    twowindows} {
+	while {[testobjconfig info $t] != ""} {
+	    testobjconfig delete $t
+	}
+    }
+}
+
+foreach i [winfo children .] {
+    destroy $i
+}
+killTables
+wm geometry . {}
+raise .
+
+test config-1.1 {Tk_CreateOptionTable - reference counts} {
+    eval destroy [winfo children .]
+    killTables
+    set x {}
+    testobjconfig alltypes .a
+    lappend x [testobjconfig info alltypes]
+    testobjconfig alltypes .b
+    lappend x [testobjconfig info alltypes]
+    eval destroy [winfo children .]
+    set x
+} {{1 15 -boolean} {2 15 -boolean}}
+test config-1.2 {Tk_CreateOptionTable - synonym initialization} {
+    eval destroy [winfo children .]
+    testobjconfig alltypes .a -synonym green
+    .a cget -color
+} {green}
+test config-1.3 {Tk_CreateOptionTable - option database initialization} {
+    eval destroy [winfo children .]
+    option clear
+    testobjconfig alltypes .a
+    option add *b.string different
+    testobjconfig alltypes .b
+    list [.a cget -string] [.b cget -string]
+} {foo different}
+test config-1.4 {Tk_CreateOptionTable - option database initialization} {
+    eval destroy [winfo children .]
+    option clear
+    testobjconfig alltypes .a
+    option add *b.String bar
+    testobjconfig alltypes .b
+    list [.a cget -string] [.b cget -string]
+} {foo bar}
+test config-1.5 {Tk_CreateOptionTable - default initialization} {
+    eval destroy [winfo children .]
+    testobjconfig alltypes .a
+    .a cget -relief
+} {raised}
+test config-1.6 {Tk_CreateOptionTable - chained tables} {
+    eval destroy [winfo children .]
+    killTables
+    testobjconfig chain1 .a
+    testobjconfig chain2 .b
+    testobjconfig info chain2
+} {1 4 -three 2 2 -one}
+test config-1.7 {Tk_CreateOptionTable - chained tables} {
+    eval destroy [winfo children .]
+    killTables
+    testobjconfig chain2 .b
+    testobjconfig chain1 .a
+    testobjconfig info chain2
+} {1 4 -three 2 2 -one}
+test config-1.8 {Tk_CreateOptionTable - chained tables} {
+    eval destroy [winfo children .]
+    testobjconfig chain1 .a
+    testobjconfig chain2 .b
+    list [catch {.a cget -four} msg] $msg [.a cget -one] \
+	    [.b cget -four] [.b cget -one]
+} {1 {unknown option "-four"} one four one}
+
+test config-2.1 {Tk_DeleteOptionTable - reference counts} {
+    eval destroy [winfo children .]
+    killTables
+    testobjconfig chain1 .a
+    testobjconfig chain2 .b
+    testobjconfig chain2 .c
+    eval destroy [winfo children .]
+    set x {}
+    testobjconfig delete chain2
+    lappend x [testobjconfig info chain2] [testobjconfig info chain1]
+    testobjconfig delete chain2
+    lappend x [testobjconfig info chain2] [testobjconfig info chain1]
+} {{1 4 -three 2 2 -one} {2 2 -one} {} {1 2 -one}}
+
+# No tests for DestroyOptionHashTable; couldn't figure out how to test.
+
+test config-3.1 {Tk_InitOptions - priority of chained tables} {
+    eval destroy [winfo children .]
+    testobjconfig chain1 .a
+    testobjconfig chain2 .b
+    list [.a cget -two] [.b cget -two]
+} {two {two and a half}}
+test config-3.2 {Tk_InitOptions - initialize from database} {
+    eval destroy [winfo children .]
+    option clear
+    option add *a.color blue
+    testobjconfig alltypes .a
+    list [.a cget -color]
+} {blue}
+test config-3.3 {Tk_InitOptions - initialize from database} {
+    eval destroy [winfo children .]
+    option clear
+    option add *a.justify bogus
+    testobjconfig alltypes .a
+    list [.a cget -justify]
+} {left}
+test config-3.4 {Tk_InitOptions - initialize from widget class} {
+    eval destroy [winfo children .]
+    testobjconfig alltypes .a
+    list [.a cget -color]
+} {red}
+test config-3.5 {Tk_InitOptions - no initial value} {
+    eval destroy [winfo children .]
+    testobjconfig alltypes .a
+    .a cget -anchor
+} {}
+test config-3.6 {Tk_InitOptions - bad initial value} {
+    eval destroy [winfo children .]
+    option clear
+    option add *a.color non-existent
+    list [catch {testobjconfig alltypes .a} msg] $msg $errorInfo
+} {1 {unknown color name "non-existent"} {unknown color name "non-existent"
+    (database entry for "-color" in widget ".a")
+    invoked from within
+"testobjconfig alltypes .a"}}
+option clear
+test config-3.7 {Tk_InitOptions - bad initial value} {
+    eval destroy [winfo children .]
+    list [catch {testobjconfig configerror} msg] $msg $errorInfo
+} {1 {expected integer but got "bogus"} {expected integer but got "bogus"
+    (default value for "-int")
+    invoked from within
+"testobjconfig configerror"}}
+option clear
+
+test config-4.1 {DoObjConfig - boolean} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -boolean 0} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 0 0}
+test config-4.2 {DoObjConfig - boolean} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -boolean 1} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 1 0}
+test config-4.3 {DoObjConfig - invalid boolean} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -boolean {}} msg] $msg
+} {1 {expected boolean value but got ""}}
+test config-4.4 {DoObjConfig - boolean internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -boolean 0
+    .foo cget -boolean
+} {0}
+test config-4.5 {DoObjConfig - integer} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -integer 3} msg] $msg [catch {.foo cget -integer} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 3 0}
+test config-4.6 {DoObjConfig - invalid integer} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -integer bar} msg] $msg
+} {1 {expected integer but got "bar"}}
+test config-4.7 {DoObjConfig - integer internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -integer 421
+    .foo cget -integer
+} {421}
+test config-4.8 {DoObjConfig - double} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -double 3.14} msg] $msg [catch {.foo cget -double} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 3.14 0}
+test config-4.9 {DoObjConfig - invalid double} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -double bar} msg] $msg
+} {1 {expected floating-point number but got "bar"}}
+test config-4.10 {DoObjConfig - double internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -double 62.75
+    .foo cget -double
+} {62.75}
+test config-4.11 {DoObjConfig - string} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -string test} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo]
+} {0 .foo 0 test {}}
+test config-4.12 {DoObjConfig - null string} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -string {}} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.13 {DoObjConfig - string internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -string "this is a test"
+    .foo cget -string
+} {this is a test}
+test config-4.14 {DoObjConfig - string table} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -stringtable two} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo]
+} {0 .foo 0 two {}}
+test config-4.15 {DoObjConfig - invalid string table} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -stringtable foo} msg] $msg
+} {1 {bad stringtable "foo": must be one, two, three, or four}}
+test config-4.16 {DoObjConfig - new string table} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -stringtable two
+    list [catch {.foo configure -stringtable three} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo]
+} {0 16 0 three {}}
+test config-4.17 {DoObjConfig - stringtable internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -stringtable "four"
+    .foo cget -stringtable
+} {four}
+test config-4.18 {DoObjConfig - color} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -color blue} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 .foo 0 blue {}}
+test config-4.19 {DoObjConfig - invalid color} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -color xxx} msg] $msg
+} {1 {unknown color name "xxx"}}
+test config-4.20 {DoObjConfig - color internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -color purple
+    .foo cget -color
+} {purple}
+test config-4.21 {DoObjConfig - null color} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -color {}} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.22 {DoObjConfig - getting rid of old color} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -color #333333
+    list [catch {.foo configure -color #444444} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 32 0 #444444 {}}
+test config-4.23 {DoObjConfig - font} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 .foo 0 {Helvetica 72} {}}
+test config-4.24 {DoObjConfig - new font} {
+    catch {rename .foo {}}
+    testobjconfig alltypes .foo -font {Courier 12}
+    list [catch {.foo configure -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 64 0 {Helvetica 72} {}}
+test config-4.25 {DoObjConfig - invalid font} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -font {Helvetica 12 foo}} msg] $msg
+} {1 {unknown font style "foo"}}
+test config-4.26 {DoObjConfig - null font} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -font {}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.27 {DoObjConfig - font internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -font {Times 16}
+    .foo cget -font
+} {Times 16}
+test config-4.28 {DoObjConfig - bitmap} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -bitmap gray75} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 .foo 0 gray75 {}}
+test config-4.29 {DoObjConfig - new bitmap} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -bitmap gray75
+    list [catch {.foo configure -bitmap gray50} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 128 0 gray50 {}}
+test config-4.30 {DoObjConfig - invalid bitmap} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -bitmap foo} msg] $msg
+} {1 {bitmap "foo" not defined}}
+test config-4.31 {DoObjConfig - null bitmap} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -bitmap {}} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.32 {DoObjConfig - bitmap internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -bitmap gray25
+    .foo cget -bitmap
+} {gray25}
+test config-4.33 {DoObjConfig - border} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -border green} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 .foo 0 green {}}
+test config-4.34 {DoObjConfig - invalid border} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -border xxx} msg] $msg
+} {1 {unknown color name "xxx"}}
+test config-4.35 {DoObjConfig - null border} {
+    catch {rename .foo {}}
+    list [catch {testobjconfig alltypes .foo -border {}} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.36 {DoObjConfig - border internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -border #123456
+    .foo cget -border
+} {#123456}
+test config-4.37 {DoObjConfig - getting rid of old border} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -border #333333
+    list [catch {.foo configure -border #444444} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 256 0 #444444 {}}
+test config-4.38 {DoObjConfig - relief} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo]
+} {0 .foo 0 flat {}}
+test config-4.39 {DoObjConfig - invalid relief} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -relief foo} msg] $msg
+} {1 {bad relief "foo": must be flat, groove, raised, ridge, solid, or sunken}}
+test config-4.40 {DoObjConfig - new relief} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -relief raised
+    list [catch {.foo configure -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo]
+} {0 512 0 flat {}}
+test config-4.41 {DoObjConfig - relief internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -relief ridge
+    .foo cget -relief
+} {ridge}
+test config-4.42 {DoObjConfig - cursor} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 .foo 0 arrow {}}
+test config-4.43 {DoObjConfig - invalid cursor} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -cursor foo} msg] $msg
+} {1 {bad cursor spec "foo"}}
+test config-4.44 {DoObjConfig - null cursor} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -cursor {}} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.45 {DoObjConfig - new cursor} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -cursor xterm
+    list [catch {.foo configure -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 1024 0 arrow {}}
+test config-4.46 {DoObjConfig - cursor internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -cursor watch
+    .foo cget -cursor
+} {watch}
+test config-4.47 {DoObjConfig - justify} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -justify center} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo]
+} {0 .foo 0 center {}}
+test config-4.48 {DoObjConfig - invalid justify} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -justify foo} msg] $msg
+} {1 {bad justification "foo": must be left, right, or center}}
+test config-4.49 {DoObjConfig - new justify} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -justify left
+    list [catch {.foo configure -justify right} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo]
+} {0 2048 0 right {}}
+test config-4.50 {DoObjConfig - justify internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -justify center
+    .foo cget -justify
+} {center}
+test config-4.51 {DoObjConfig - anchor} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -anchor center} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo]
+} {0 .foo 0 center {}}
+test config-4.52 {DoObjConfig - invalid anchor} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -anchor foo} msg] $msg
+} {1 {bad anchor "foo": must be n, ne, e, se, s, sw, w, nw, or center}}
+test config-4.53 {DoObjConfig - new anchor} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -anchor e
+    list [catch {.foo configure -anchor n} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo]
+} {0 4096 0 n {}}
+test config-4.54 {DoObjConfig - anchor internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -anchor sw
+    .foo cget -anchor
+} {sw}
+test config-4.55 {DoObjConfig - pixel} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -pixel 42} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo]
+} {0 .foo 0 42 {}}
+test config-4.56 {DoObjConfig - invalid pixel} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -pixel foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+test config-4.57 {DoObjConfig - new pixel} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -pixel 42m
+    list [catch {.foo configure -pixel 3c} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo]
+} {0 8192 0 3c {}}
+test config-4.58 {DoObjConfig - pixel internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -pixel [winfo screenmmwidth .]m
+    .foo cget -pixel
+} [winfo screenwidth .]
+test config-4.59 {DoObjConfig - window} {
+    catch {destroy .foo}
+    catch {destroy .bar}
+    toplevel .bar
+    list [catch {testobjconfig twowindows .foo -window .bar} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar]
+} {0 .foo 0 .bar {} {}}
+test config-4.60 {DoObjConfig - invalid window} {
+    catch {destroy .foo}
+    toplevel .bar
+    list [catch {testobjconfig twowindows .foo -window foo} msg] $msg [destroy .bar]
+} {1 {bad window path name "foo"} {}}
+test config-4.61 {DoObjConfig - null window} {
+    catch {destroy .foo}
+    catch {destroy .bar}
+    toplevel .bar
+    list [catch {testobjconfig twowindows .foo -window {}} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.62 {DoObjConfig - new window} {
+    catch {destroy .foo}
+    catch {destroy .bar}
+    catch {destroy .blamph}
+    toplevel .bar
+    toplevel .blamph
+    testobjconfig twowindows .foo -window .bar
+    list [catch {.foo configure -window .blamph} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar] [destroy .blamph]
+} {0 0 0 .blamph {} {} {}}
+test config-4.63 {DoObjConfig - window internal value} {
+    catch {rename .foo {}}
+    testobjconfig internal .foo -window .
+    .foo cget -window
+} {.}
+test config-4.64 {DoObjConfig - releasing old values} {
+    # This test doesn't generate a useful value to check; if an
+    # error occurs, it will be detected only by memory checking software
+    # such as Purify or Tcl's built-in checker.
+
+    catch {rename .foo {}}
+    testobjconfig alltypes .foo -string {Test string} -color yellow \
+	    -font {Courier 18} -bitmap questhead -border green -cursor cross
+    .foo configure -string {new string} -color brown \
+	    -font {Times 8} -bitmap gray75 -border pink -cursor watch
+    concat {}
+} {}
+test config-4.65 {DoObjConfig - releasing old values} {
+    # This test doesn't generate a useful value to check; if an
+    # error occurs, it will be detected only by memory checking software
+    # such as Purify or Tcl's built-in checker.
+
+    catch {rename .foo {}}
+    testobjconfig internal .foo -string {Test string} -color yellow \
+	    -font {Courier 18} -bitmap questhead -border green -cursor cross
+    .foo configure -string {new string} -color brown \
+	    -font {Times 8} -bitmap gray75 -border pink -cursor watch
+    concat {}
+} {}
+
+test config-5.1 {ObjectIsEmpty - object is already string} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -color [format ""]
+    .foo cget -color
+} {}
+test config-5.2 {ObjectIsEmpty - object is already string} {
+    catch {destroy .foo}
+    list [catch {testobjconfig alltypes .foo -color [format " "]} msg] $msg
+} {1 {unknown color name " "}}
+test config-5.3 {ObjectIsEmpty - must convert back to string} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -color [list]
+    .foo cget -color
+} {}
+
+eval destroy [winfo children .]
+testobjconfig chain2 .a
+testobjconfig alltypes .b
+test config-6.1 {GetOptionFromObj - cached answer} {
+    list [.a cget -three] [.a cget -three]
+} {three three}
+test config-6.2 {GetOptionFromObj - exact match} {
+    .a cget -one
+} {one}
+test config-6.3 {GetOptionFromObj - abbreviation} {
+    .a cget -fo
+} {four}
+test config-6.4 {GetOptionFromObj - ambiguous abbreviation} {
+    list [catch {.a cget -on} msg] $msg
+} {1 {unknown option "-on"}}
+test config-6.5 {GetOptionFromObj - duplicate options in different tables} {
+    .a cget -tw
+} {two and a half}
+test config-6.6 {GetOptionFromObj - synonym} {
+    .b cget -synonym
+} {red}
+
+eval destroy [winfo children .]
+testobjconfig alltypes .a
+test config-7.1 {Tk_SetOptions - basics} {
+    .a configure -color green -rel sunken
+     list [.a cget -color] [.a cget -relief]
+} {green sunken}
+test config-7.2 {Tk_SetOptions - bogus option name} {
+    list [catch {.a configure -bogus} msg] $msg
+} {1 {unknown option "-bogus"}}
+test config-7.3 {Tk_SetOptions - synonym} {
+    .a configure -synonym blue
+    .a cget -color
+} {blue}
+test config-7.4 {Tk_SetOptions - missing value} {
+    list [catch {.a configure -color green -relief} msg] $msg [.a cget -color]
+} {1 {value for "-relief" missing} green}
+test config-7.5 {Tk_SetOptions - saving old values} {
+    .a configure -color red -int 7 -relief raised -double 3.14159
+    list [catch {.a csave -color green -int 432 -relief sunken \
+	    -double 2.0 -color bogus} msg] $msg [.a cget -color] \
+	    [.a cget -int] [.a cget -relief] [.a cget -double]
+} {1 {unknown color name "bogus"} red 7 raised 3.14159}
+test config-7.6 {Tk_SetOptions - error in DoObjConfig call} {
+    list [catch {.a configure -color bogus} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+    (processing "-color" option)
+    invoked from within
+".a configure -color bogus"}}
+test config-7.7 {Tk_SetOptions - synonym name in error message} {
+    list [catch {.a configure -synonym bogus} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+    (processing "-synonym" option)
+    invoked from within
+".a configure -synonym bogus"}}
+test config-7.8 {Tk_SetOptions - returning mask} {
+    format %x [.a configure -color red -int 7 -relief raised -double 3.14159]
+} {226}
+
+test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} {
+    eval destroy [winfo children .]
+    testobjconfig alltypes .a
+    list [catch {.a csave -color green -color black -color blue \
+	    -color #ffff00 -color #ff00ff -color bogus} msg] $msg \
+	    [.a cget -color]
+} {1 {unknown color name "bogus"} red}
+test config-8.2 {Tk_RestoreSavedOptions - freeing object memory} {
+    eval destroy [winfo children .]
+    testobjconfig alltypes .a
+    .a csave -color green -color black -color blue -color #ffff00 \
+	    -color #ff00ff
+} {32}
+test config-8.3 {Tk_RestoreSavedOptions - boolean internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -boolean 0 -color bogus}] [.a cget -boolean]
+} {1 1}
+test config-8.4 {Tk_RestoreSavedOptions - integer internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -integer 24 -color bogus}] [.a cget -integer]
+} {1 148962237}
+test config-8.5 {Tk_RestoreSavedOptions - double internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -double 62.4 -color bogus}] [.a cget -double]
+} {1 3.14159}
+test config-8.6 {Tk_RestoreSavedOptions - string internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -string "A long string" -color bogus}] \
+	    [.a cget -string]
+} {1 foo}
+test config-8.7 {Tk_RestoreSavedOptions - string table internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -stringtable three -color bogus}] \
+	    [.a cget -stringtable]
+} {1 one}
+test config-8.8 {Tk_RestoreSavedOptions - color internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -color green -color bogus}] [.a cget -color]
+} {1 red}
+test config-8.9 {Tk_RestoreSavedOptions - font internal form} {nonPortable} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -font {Times 12} -color bogus}] [.a cget -font]
+} {1 {Helvetica 12}}
+test config-8.10 {Tk_RestoreSavedOptions - bitmap internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -bitmap questhead -color bogus}] [.a cget -bitmap]
+} {1 gray50}
+test config-8.11 {Tk_RestoreSavedOptions - border internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -border brown -color bogus}] [.a cget -border]
+} {1 blue}
+test config-8.12 {Tk_RestoreSavedOptions - relief internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -relief sunken -color bogus}] [.a cget -relief]
+} {1 raised}
+test config-8.13 {Tk_RestoreSavedOptions - cursor internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -cursor watch -color bogus}] [.a cget -cursor]
+} {1 xterm}
+test config-8.14 {Tk_RestoreSavedOptions - justify internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -justify right -color bogus}] [.a cget -justify]
+} {1 left}
+test config-8.15 {Tk_RestoreSavedOptions - anchor internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a
+    list [catch {.a csave -anchor center -color bogus}] [.a cget -anchor]
+} {1 n}
+test config-8.16 {Tk_RestoreSavedOptions - window internal form} {
+    eval destroy [winfo children .]
+    testobjconfig internal .a -window .a
+    list [catch {.a csave -window .a -color bogus}] [.a cget -window]
+} {1 .a}
+
+# Most of the tests below will cause memory leakage if there is a
+# problem.  This may not be evident unless the tests are run in
+# conjunction with a memory usage analyzer such as Purify.
+
+test config-9.1 {Tk_FreeConfigOptions/FreeResources - string internal form} {
+    catch {destroy .foo}
+    testobjconfig internal .foo
+    .foo configure -string "two words"
+    destroy .foo
+} {}
+test config-9.2 {Tk_FreeConfigOptions/FreeResources - color internal form} {
+    catch {destroy .foo}
+    testobjconfig internal .foo
+    .foo configure -color yellow
+    destroy .foo
+} {}
+test config-9.3 {Tk_FreeConfigOptions/FreeResources - color} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo
+    .foo configure -color [format blue]
+    destroy .foo
+} {}
+test config-9.4 {Tk_FreeConfigOptions/FreeResources - font internal form} {
+    catch {destroy .foo}
+    testobjconfig internal .foo
+    .foo configure -font {Courier 20}
+    destroy .foo
+} {}
+test config-9.5 {Tk_FreeConfigOptions/FreeResources - font} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo
+    .foo configure -font [format {Courier 24}]
+    destroy .foo
+} {}
+test config-9.6 {Tk_FreeConfigOptions/FreeResources - bitmap internal form} {
+    catch {destroy .foo}
+    testobjconfig internal .foo
+    .foo configure -bitmap gray75
+    destroy .foo
+} {}
+test config-9.7 {Tk_FreeConfigOptions/FreeResources - bitmap} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo
+    .foo configure -bitmap [format gray75]
+    destroy .foo
+} {}
+test config-9.8 {Tk_FreeConfigOptions/FreeResources - border internal form} {
+    catch {destroy .foo}
+    testobjconfig internal .foo
+    .foo configure -border orange
+    destroy .foo
+} {}
+test config-9.9 {Tk_FreeConfigOptions/FreeResources - border} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo
+    .foo configure -border [format blue]
+    destroy .foo
+} {}
+test config-9.10 {Tk_FreeConfigOptions/FreeResources - cursor internal form} {
+    catch {destroy .foo}
+    testobjconfig internal .foo
+    .foo configure -cursor cross
+    destroy .foo
+} {}
+test config-9.11 {Tk_FreeConfigOptions/FreeResources - cursor} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo
+    .foo configure -cursor [format watch]
+    destroy .foo
+} {}
+test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo
+    .foo configure -integer [format 27]
+    destroy .foo
+} {}
+
+test config-10.1 {Tk_GetOptionInfo - one item} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo
+    .foo configure -relief groove
+    .foo configure -relief
+} {-relief relief Relief raised groove}
+test config-10.2 {Tk_GetOptionInfo - one item, synonym} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo
+    .foo configure -color black
+    .foo configure -synonym
+} {-color color Color red black}
+test config-10.3 {Tk_GetOptionInfo - all items} {
+    catch {destroy .foo}
+    testobjconfig alltypes .foo -font {Helvetica 18} -integer 13563
+    .foo configure
+} {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-pixel pixel Pixel 1 1} {-synonym -color}}
+test config-10.4 {Tk_GetOptionInfo - chaining through tables} {
+    catch {destroy .foo}
+    testobjconfig chain2 .foo -one asdf -three xyzzy
+    .foo configure
+} {{-three three Three three xyzzy} {-four four Four four four} {-two two Two {two and a half} {two and a half}} {-oneAgain oneAgain OneAgain {one again} {one again}} {-one one One one asdf} {-two two Two two {two and a half}}}
+
+eval destroy [winfo children .]
+testobjconfig alltypes .a
+test config-11.1 {GetConfigList - synonym} {
+    lindex [.a configure] end
+} {-synonym -color}
+test config-11.2 {GetConfigList - null database names} {
+    .a configure -justify
+} {-justify {} {} left left}
+test config-11.3 {GetConfigList - null default and current value} {
+    .a configure -anchor
+} {-anchor anchor Anchor {} {}}
+
+eval destroy [winfo children .]
+testobjconfig internal .a
+test config-12.1 {GetObjectForOption - boolean} {
+    .a configure -boolean 0
+    .a cget -boolean
+} {0}
+test config-12.2 {GetObjectForOption - integer} {
+    .a configure -integer 1247
+    .a cget -integer
+} {1247}
+test config-12.3 {GetObjectForOption - double} {
+    .a configure -double -88.82
+    .a cget -double
+} {-88.82}
+test config-12.4 {GetObjectForOption - string} {
+    .a configure -string "test value"
+    .a cget -string
+} {test value}
+test config-12.5 {GetObjectForOption - stringTable} {
+    .a configure -stringtable "two"
+    .a cget -stringtable
+} {two}
+test config-12.6 {GetObjectForOption - color} {
+    .a configure -color "green"
+    .a cget -color
+} {green}
+test config-12.7 {GetObjectForOption - font} {
+    .a configure -font {Times 36}
+    .a cget -font
+} {Times 36}
+test config-12.8 {GetObjectForOption - bitmap} {
+    .a configure -bitmap "questhead"
+    .a cget -bitmap
+} {questhead}
+test config-12.9 {GetObjectForOption - border} {
+    .a configure -border #33217c
+    .a cget -border
+} {#33217c}
+test config-12.10 {GetObjectForOption - relief} {
+    .a configure -relief groove
+    .a cget -relief
+} {groove}
+test config-12.11 {GetObjectForOption - cursor} {
+    .a configure -cursor watch
+    .a cget -cursor
+} {watch}
+test config-12.12 {GetObjectForOption - justify} {
+    .a configure -justify right
+    .a cget -justify
+} {right}
+test config-12.13 {GetObjectForOption - anchor} {
+    .a configure -anchor e
+    .a cget -anchor
+} {e}
+test config-12.14 {GetObjectForOption - pixels} {
+    .a configure -pixel 193.2
+    .a cget -pixel
+} {193}
+test config-12.15 {GetObjectForOption - window} {
+    .a configure -window .a
+    .a cget -window
+} {.a}
+test config-12.16 {GetObjectForOption - null values} {
+    .a configure -string {} -color {} -font {} -bitmap {} -border {} \
+	    -cursor {} -window {}
+    list [.a cget -string] [.a cget -color] [.a cget -font] \
+	    [.a cget -string] [.a cget -bitmap] [.a cget -border] \
+	    [.a cget -cursor] [.a cget -window]
+} {{} {} {} {} {} {} {} {}}
+
+# cleanup
+eval destroy [winfo children .]
+killTables
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/cursor.test b/tests/cursor.test
new file mode 100644
index 0000000..bb01561
--- /dev/null
+++ b/tests/cursor.test
@@ -0,0 +1,116 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkCursor.c.  It is organized in the standard white-box fashion for
+# Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: cursor.test,v 1.2 1999/04/16 01:51:36 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info commands testcursor] != "testcursor"} {
+    puts "testcursor command not available; skipping tests"
+    ::tcltest::cleanupTests
+    return
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {
+    set x watch
+    lindex $x 0
+    destroy .b1
+    button .b1 -cursor $x
+    lindex $x 0
+    testcursor watch
+} {{1 0}}
+test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} {
+    set x watch
+    destroy .b1 .b2
+    button .b1 -cursor $x
+    destroy .b1
+    set result {}
+    lappend result [testcursor watch]
+    button .b2 -cursor $x
+    lappend result [testcursor watch]
+} {{} {{1 1}}}
+test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} {
+    set x watch
+    destroy .b1 .b2
+    button .b1 -cursor $x
+    set result {}
+    lappend result [testcursor watch]
+    button .b2 -cursor $x
+    pack .b1 .b2 -side top
+    lappend result [testcursor watch]
+} {{{1 1}} {{2 1}}}
+
+test cursor-2.1 {Tk_GetCursor procedure} {
+    destroy .b1
+    list [catch {button .b1 -cursor bad_name} msg] $msg
+} {1 {bad cursor spec "bad_name"}}
+test cursor-2.2 {Tk_GetCursor procedure} {
+    destroy .b1
+    list [catch {button .b1 -cursor @xyzzy} msg] $msg
+} {1 {bad cursor spec "@xyzzy"}}
+
+test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {
+    set x arrow
+    destroy .b1 .b2 .b3
+    button .b1 -cursor $x
+    button .b3 -cursor $x
+    button .b2 -cursor $x
+    set result {}
+    lappend result [testcursor arrow]
+    destroy .b1
+    lappend result [testcursor arrow]
+    destroy .b2
+    lappend result [testcursor arrow]
+    destroy .b3
+    lappend result [testcursor arrow]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+
+test cursor-4.1 {FreeCursorObjProc} {
+    destroy .b
+    set x [format arrow]
+    button .b -cursor $x
+    set y [format arrow]
+    .b configure -cursor $y
+    set z [format arrow]
+    .b configure -cursor $z
+    set result {}
+    lappend result [testcursor arrow]
+    set x red
+    lappend result [testcursor arrow]
+    set z 32
+    lappend result [testcursor arrow]
+    destroy .b
+    lappend result [testcursor arrow]
+    set y bogus
+    set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/defs b/tests/defs
deleted file mode 100644
index a7037ee..0000000
--- a/tests/defs
+++ /dev/null
@@ -1,372 +0,0 @@
-# This file contains support code for the Tcl test suite.  It is
-# normally sourced by the individual files in the test suite before
-# they run their tests.  This improved approach to testing was designed
-# and initially implemented by Mary Ann May-Pumphrey of Sun Microsystems.
-#
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: defs,v 1.4 1999/04/16 01:25:55 stanton Exp $
-
-if {![info exists VERBOSE]} {
-    set VERBOSE 0
-}
-if {![info exists TESTS]} {
-    set TESTS {}
-}
-
-tk appname tktest
-wm title . tktest
-
-# Check configuration information that will determine which tests
-# to run.  To do this, create an array testConfig.  Each element
-# has a 0 or 1 value, and the following elements are defined:
-#	unixOnly -	1 means this is a UNIX platform, so it's OK
-#			to run tests that only work under UNIX.
-#	macOnly -	1 means this is a Mac platform, so it's OK
-#			to run tests that only work on Macs.
-#	pcOnly -	1 means this is a PC platform, so it's OK to
-#			run tests that only work on PCs.
-#	unixOrPc -	1 means this is a UNIX or PC platform.
-#	macOrPc -	1 means this is a Mac or PC platform.
-#	macOrUnix -	1 means this is a Mac or UNIX platform.
-#	nonPortable -	1 means this the tests are being running in
-#			the master Tcl/Tk development environment;
-#			Some tests are inherently non-portable because
-#			they depend on things like word length, file system
-#			configuration, window manager, etc.  These tests
-#			are only run in the main Tcl development directory
-#			where the configuration is well known.  The presence
-#			of the file "doAllTests" in this directory indicates
-#			that it is safe to run non-portable tests.
-#	fonts -		1 means that this platform uses fonts with
-#			well-know geometries, so it is safe to run
-#			tests that depend on particular font sizes.
-
-catch {unset testConfig}
-
-set testConfig(unixOnly) 	[expr {$tcl_platform(platform) == "unix"}]
-set testConfig(macOnly) 	[expr {$tcl_platform(platform) == "macintosh"}]
-set testConfig(pcOnly)		[expr {$tcl_platform(platform) == "windows"}]
-
-set testConfig(unix)		$testConfig(unixOnly)
-set testConfig(mac)		$testConfig(macOnly)
-set testConfig(pc)		$testConfig(pcOnly)
-
-set testConfig(unixOrPc) [expr {$testConfig(unixOnly) || $testConfig(pcOnly)}]
-set testConfig(macOrPc) [expr {$testConfig(macOnly) || $testConfig(pcOnly)}]
-set testConfig(macOrUnix) [expr {$testConfig(macOnly) || $testConfig(unixOnly)}]
-
-set testConfig(nonPortable) 	[expr {[file exists doAllTests] || [file exists DOALLT~1]}]
-
-set testConfig(nt)		[expr {$tcl_platform(os) == "Windows NT"}]
-set testConfig(95)		[expr {$tcl_platform(os) == "Windows 95"}]
-set testConfig(win32s)		[expr {$tcl_platform(os) == "Win32s"}]
-
-# The following config switches are used to mark tests that should work,
-# but have been temporarily disabled on certain platforms because they don't.
-
-set testConfig(tempNotPc) 	[expr {!$testConfig(pc)}]
-set testConfig(tempNotMac) 	[expr {!$testConfig(mac)}]
-set testConfig(tempNotUnix)	[expr {!$testConfig(unix)}]
-
-# The following config switches are used to mark tests that crash on
-# certain platforms, so that they can be reactivated again when the
-# underlying problem is fixed.
-
-set testConfig(pcCrash) 	[expr {!$testConfig(pc)}]
-set testConfig(win32sCrash) 	[expr {!$testConfig(win32s)}]
-set testConfig(macCrash) 	[expr {!$testConfig(mac)}]
-set testConfig(unixCrash) 	[expr {!$testConfig(unix)}]
-
-set testConfig(fonts) 1
-catch {destroy .e}
-entry .e -width 0 -font {Helvetica -12} -bd 1
-.e insert end "a.bcd"
-if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
-    set testConfig(fonts) 0
-}
-destroy .e .t
-text .t -width 80 -height 20 -font {Times -14} -bd 1
-pack .t
-.t insert end "This is\na dot."
-update
-set x [list [.t bbox 1.3] [.t bbox 2.5]]
-destroy .t
-if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} {
-    set testConfig(fonts) 0
-}
-
-if {$testConfig(nonPortable) == 0} {
-    puts stdout "(will skip non-portable tests)"
-}
-if {$testConfig(fonts) == 0} {
-    puts stdout "(will skip font-sensitive tests: this system has unexpected font geometries)"
-}
-
-trace variable testConfig r safeFetch
-
-proc safeFetch {n1 n2 op} {
-    global testConfig 
-
-    if {($n2 != {}) && ([info exists testConfig($n2)] == 0)} {
-	set testConfig($n2) 0
-    }
-}
-
-# If there is no "memory" command (because memory debugging isn't
-# enabled), generate a dummy command that does nothing.
-
-if {[info commands memory] == ""} {
-    proc memory args {}
-}
-
-proc print_verbose {name description script code answer} {
-    puts stdout "\n"
-    puts stdout "==== $name $description"
-    puts stdout "==== Contents of test case:"
-    puts stdout "$script"
-    if {$code != 0} {
-	if {$code == 1} {
-	    puts stdout "==== Test generated error:"
-	    puts stdout $answer
-	} elseif {$code == 2} {
-	    puts stdout "==== Test generated return exception;  result was:"
-	    puts stdout $answer
-	} elseif {$code == 3} {
-	    puts stdout "==== Test generated break exception"
-	} elseif {$code == 4} {
-	    puts stdout "==== Test generated continue exception"
-	} else {
-	    puts stdout "==== Test generated exception $code;  message was:"
-	    puts stdout $answer
-	}
-    } else {
-	puts stdout "==== Result was:"
-	puts stdout "$answer"
-    }
-}
-
-# test --
-# This procedure runs a test and prints an error message if the
-# test fails.  If VERBOSE has been set, it also prints a message
-# even if the test succeeds.  The test will be skipped if it
-# doesn't match the TESTS variable, or if one of the elements
-# of "constraints" turns out not to be true.
-#
-# Arguments:
-# name -		Name of test, in the form foo-1.2.
-# description -		Short textual description of the test, to
-#			help humans understand what it does.
-# constraints -		A list of one or more keywords, each of
-#			which must be the name of an element in
-#			the array "testConfig".  If any of these
-#			elements is zero, the test is skipped.
-#			This argument may be omitted.
-# script -		Script to run to carry out the test.  It must
-#			return a result that can be checked for
-#			correctness.
-# answer -		Expected result from script.
-
-proc test {name description script answer args} {
-    global VERBOSE TESTS testConfig
-    if {[string compare $TESTS ""] != 0} {
-	set ok 0
-	foreach test $TESTS {
-	    if {[string match $test $name]} {
-		set ok 1
-		break
-	    }
-        }
-	if {!$ok} {
-	    return
-	}
-    }
-    set i [llength $args]
-    if {$i == 0} {
-	# Empty body
-    } elseif {$i == 1} {
-	# "constraints" argument exists;  shuffle arguments down, then
-	# make sure that the constraints are satisfied.
-
-	set constraints $script
-	set script $answer
-	set answer [lindex $args 0]
-	set doTest 0
-	if {[string match {*[$\[]*} $constraints] != 0} {
-	    # full expression, e.g. {$foo > [info tclversion]}
-
-	    catch {set doTest [uplevel #0 expr $constraints]}
-	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
-	    # something like {a || b} should be turned into 
-	    # $testConfig(a) || $testConfig(b).
-
- 	    regsub -all {[.a-zA-Z0-9]+} $constraints {$testConfig(&)} c
-	    catch {set doTest [eval expr $c]}
-	} else {
-	    # just simple constraints such as {unixOnly fonts}.
-
-	    set doTest 1
-	    foreach constraint $constraints {
-		if {![info exists testConfig($constraint)]
-			|| !$testConfig($constraint)} {
-		    set doTest 0
-		    break
-		}
-	    }
-	}
-	if {$doTest == 0} {
-	    if {$VERBOSE} {
-		puts stdout "++++ $name SKIPPED: $constraints"
-	    }
-	    return	
-	}
-    } else {
-	error "wrong # args: must be \"test name description ?constraints? script answer\""
-    }
-    memory tag $name
-    set code [catch {uplevel $script} result]
-    if {$code != 0} {
-	print_verbose $name $description $script $code $result
-    } elseif {[string compare $result $answer] == 0} { 
-	if {$VERBOSE} {
-	    if {$VERBOSE > 0} {
-		print_verbose $name $description $script $code $result
-	    }
-	    if {$VERBOSE != -2} {
-		puts stdout "++++ $name PASSED"
-	    }
-	}
-    } else { 
-	print_verbose $name $description $script $code $result 
-	puts stdout "---- Result should have been:"
-	puts stdout "$answer"
-	puts stdout "---- $name FAILED" 
-    }
-    if {[string compare $::tcl_platform(platform) macintosh] == 0} {
-        # Force the text to be drawn even if the tests are not updating.
-        update idletasks
-    }
-}
-
-proc dotests {file args} {
-    global TESTS
-    set savedTests $TESTS
-    set TESTS $args
-    source $file
-    set TESTS $savedTests
-}
-
-# If the main window isn't already mapped (e.g. because the tests are
-# being run automatically) , specify a precise size for it so that the
-# user won't have to position it manually.
-
-if {![winfo ismapped .]} {
-    wm geometry . +0+0
-    update
-}
-
-# The following code can be used to perform tests involving a second
-# process running in the background.
-
-# Locate tktest executable
-
-set tktest [info nameofexecutable]
-if {$tktest == "{}"} {
-    set tktest {}
-    puts stdout "Unable to find tktest executable, skipping multiple process tests."
-}
-
-# Create background process
-
-proc setupbg args {
-    global tktest fd bgData
-    if {$tktest == ""} {
-        error "you're not running tktest so setupbg should not have been called"
-    }
-    if {[info exists fd] && ($fd != "")} {
-	cleanupbg
-    }
-    set fd [open "|[list $tktest -geometry +0+0 -name tktest] $args" r+]
-    puts $fd "puts foo; flush stdout"
-    flush $fd
-    if {[gets $fd data] < 0} {
-        error "unexpected EOF from \"$tktest\""
-    }
-    if {[string compare $data foo]} {
-        error "unexpected output from background process \"$data\""
-    }
-    fileevent $fd readable bgReady
-}
-
-# Send a command to the background process, catching errors and
-# flushing I/O channels
-proc dobg {command} {
-    global fd bgData bgDone
-    puts $fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout"
-    flush $fd
-    set bgDone 0
-    set bgData {}
-    tkwait variable bgDone
-    set bgData
-}
-
-# Data arrived from background process.  Check for special marker
-# indicating end of data for this command, and make data available
-# to dobg procedure.
-proc bgReady {} {
-    global fd bgData bgDone
-    set x [gets $fd]
-    if {[eof $fd]} {
-	fileevent $fd readable {}
-	set bgDone 1
-    } elseif {$x == "**DONE**"} {
-	set bgDone 1
-    } else {
-	append bgData $x
-    }
-}
-
-# Exit the background process, and close the pipes
-proc cleanupbg {} {
-    global fd
-    catch {
-	puts $fd "exit"
-	close $fd
-    }
-    set fd ""
-}
-
-# Clean up focus after using generate event, which
-# can leave the window manager with the wrong impression
-# about who thinks they have the focus. (BW)
-
-proc fixfocus {} {
-    catch {destroy .focus}
-    toplevel .focus
-    wm geometry .focus +0+0
-    entry .focus.e
-    .focus.e insert 0 "fixfocus"
-    pack .focus.e
-    update
-    focus -force .focus.e
-    destroy .focus
-}
-
-proc makeFile {contents name} {
-    set fd [open $name w]
-    fconfigure $fd -translation lf
-    if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} {
-	puts -nonewline $fd $contents
-    } else {
-	puts $fd $contents
-    }
-    close $fd
-}
-
-proc removeFile {name} {
-    file delete -- $name
-}
diff --git a/tests/defs.tcl b/tests/defs.tcl
new file mode 100644
index 0000000..40e147d
--- /dev/null
+++ b/tests/defs.tcl
@@ -0,0 +1,990 @@
+# defs.tcl --
+#
+#	This file contains support code for the Tcl/Tk test suite.It is
+#	It is normally sourced by the individual files in the test suite
+#	before they run their tests.  This improved approach to testing
+#	was designed and initially implemented by Mary Ann May-Pumphrey
+#	of Sun Microsystems.
+#
+# Copyright (c) 1990-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+# 
+# RCS: @(#) $Id: defs.tcl,v 1.2 1999/04/16 01:51:36 stanton Exp $
+
+# Initialize wish shell
+if {[info exists tk_version]} {
+    tk appname tktest
+    wm title . tktest
+} else {
+    # Ensure that we have a minimal auto_path so we don't pick up extra junk.
+    set auto_path [list [info library]]
+}
+
+# create the "tcltest" namespace for all testing variables and procedures
+namespace eval tcltest {
+    set procList [list test cleanupTests dotests saveState restoreState \
+	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
+	    viewFile bytestring set_iso8859_1_locale restore_locale \
+	    safeFetch]
+    if {[info exists tk_version]} {
+	lappend procList setupbg dobg bgReady cleanupbg fixfocus
+    }
+    foreach proc $procList {
+	namespace export $proc
+    }
+
+    # ::tcltest::verbose defaults to "b"
+    variable verbose "b"
+
+    # match defaults to the empty list
+    variable match {}
+
+    # skip defaults to the empty list
+    variable skip {}
+
+    # Tests should not rely on the current working directory.
+    # Files that are part of the test suite should be accessed relative to
+    # ::tcltest::testsDir.
+
+    set originalDir [pwd]
+    set tDir [file join $originalDir [file dirname [info script]]]
+    cd $tDir
+    variable testsDir [pwd]
+    cd $originalDir
+
+    # Count the number of files tested (0 if all.tcl wasn't called).
+    # The all.tcl file will set testSingleFile to false, so stats will
+    # not be printed until all.tcl calls the cleanupTests proc.
+    # The currentFailure var stores the boolean value of whether the
+    # current test file has had any failures.  The failFiles list
+    # stores the names of test files that had failures.
+
+    variable numTestFiles 0
+    variable testSingleFile true
+    variable currentFailure false
+    variable failFiles {}
+
+    # Tests should remove all files they create.  The test suite will
+    # check the current working dir for files created by the tests.
+    # ::tcltest::filesMade keeps track of such files created using the
+    # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
+    # ::tcltest::filesExisted stores the names of pre-existing files.
+
+    variable filesMade {}
+    variable filesExisted {}
+
+    # ::tcltest::numTests will store test files as indices and the list
+    # of files (that should not have been) left behind by the test files.
+    array set ::tcltest::createdNewFiles {}
+
+    # initialize ::tcltest::numTests array to keep track fo the number of
+    # tests that pass, fial, and are skipped.
+    array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0]
+
+    # initialize ::tcltest::skippedBecause array to keep track of
+    # constraints that kept tests from running
+    array set ::tcltest::skippedBecause {}
+}
+
+# If there is no "memory" command (because memory debugging isn't
+# enabled), generate a dummy command that does nothing.
+
+if {[info commands memory] == ""} {
+    proc memory args {}
+}
+
+# ::tcltest::initConfig --
+#
+# Check configuration information that will determine which tests
+# to run.  To do this, create an array ::tcltest::testConfig.  Each
+# element has a 0 or 1 value.  If the element is "true" then tests
+# with that constraint will be run, otherwise tests with that constraint
+# will be skipped.  See the README file for the list of built-in
+# constraints defined in this procedure.
+#
+# Arguments:
+#	none
+#
+# Results:
+#	The ::tcltest::testConfig array is reset to have an index for
+#	each built-in test constraint.
+
+proc ::tcltest::initConfig {} {
+
+    global tcl_platform tcl_interactive tk_version
+
+    catch {unset ::tcltest::testConfig}
+
+    # The following trace procedure makes it so that we can safely refer to
+    # non-existent members of the ::tcltest::testConfig array without causing an
+    # error.  Instead, reading a non-existent member will return 0.  This is
+    # necessary because tests are allowed to use constraint "X" without ensuring
+    # that ::tcltest::testConfig("X") is defined.
+
+    trace variable ::tcltest::testConfig r ::tcltest::safeFetch
+
+    proc ::tcltest::safeFetch {n1 n2 op} {
+	if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} {
+	    set ::tcltest::testConfig($n2) 0
+	}
+    }
+
+    set ::tcltest::testConfig(unixOnly) \
+	    [expr {$tcl_platform(platform) == "unix"}]
+    set ::tcltest::testConfig(macOnly) \
+	    [expr {$tcl_platform(platform) == "macintosh"}]
+    set ::tcltest::testConfig(pcOnly) \
+	    [expr {$tcl_platform(platform) == "windows"}]
+
+    set ::tcltest::testConfig(unix) $::tcltest::testConfig(unixOnly)
+    set ::tcltest::testConfig(mac) $::tcltest::testConfig(macOnly)
+    set ::tcltest::testConfig(pc) $::tcltest::testConfig(pcOnly)
+
+    set ::tcltest::testConfig(unixOrPc) \
+	    [expr {$::tcltest::testConfig(unix) || $::tcltest::testConfig(pc)}]
+    set ::tcltest::testConfig(macOrPc) \
+	    [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(pc)}]
+    set ::tcltest::testConfig(macOrUnix) \
+	    [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(unix)}]
+
+    set ::tcltest::testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}]
+    set ::tcltest::testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}]
+
+    # The following config switches are used to mark tests that should work,
+    # but have been temporarily disabled on certain platforms because they don't
+    # and we haven't gotten around to fixing the underlying problem.
+
+    set ::tcltest::testConfig(tempNotPc) [expr {!$::tcltest::testConfig(pc)}]
+    set ::tcltest::testConfig(tempNotMac) [expr {!$::tcltest::testConfig(mac)}]
+    set ::tcltest::testConfig(tempNotUnix) [expr {!$::tcltest::testConfig(unix)}]
+
+    # The following config switches are used to mark tests that crash on
+    # certain platforms, so that they can be reactivated again when the
+    # underlying problem is fixed.
+
+    set ::tcltest::testConfig(pcCrash) [expr {!$::tcltest::testConfig(pc)}]
+    set ::tcltest::testConfig(macCrash) [expr {!$::tcltest::testConfig(mac)}]
+    set ::tcltest::testConfig(unixCrash) [expr {!$::tcltest::testConfig(unix)}]
+
+    # Set the "fonts" constraint for wish apps
+    if {[info exists tk_version]} {
+	set ::tcltest::testConfig(fonts) 1
+	catch {destroy .e}
+	entry .e -width 0 -font {Helvetica -12} -bd 1
+	.e insert end "a.bcd"
+	if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
+	    set ::tcltest::testConfig(fonts) 0
+	}
+	destroy .e
+	catch {destroy .t}
+	text .t -width 80 -height 20 -font {Times -14} -bd 1
+	pack .t
+	.t insert end "This is\na dot."
+	update
+	set x [list [.t bbox 1.3] [.t bbox 2.5]]
+	destroy .t
+	if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} {
+	    set ::tcltest::testConfig(fonts) 0
+	}
+    }
+
+    # Skip empty tests
+    set ::tcltest::testConfig(emptyTest) 0
+
+    # By default, tests that expost known bugs are skipped.
+    set ::tcltest::testConfig(knownBug) 0
+
+    # By default, non-portable tests are skipped.
+    set ::tcltest::testConfig(nonPortable) 0
+
+    # Some tests require user interaction.
+    set ::tcltest::testConfig(userInteraction) 0
+
+    # Some tests must be skipped if the interpreter is not in interactive mode
+    set ::tcltest::testConfig(interactive) $tcl_interactive
+
+    # Some tests must be skipped if you are running as root on Unix.
+    # Other tests can only be run if you are running as root on Unix.
+    set ::tcltest::testConfig(root) 0
+    set ::tcltest::testConfig(notRoot) 1
+    set user {}
+    if {$tcl_platform(platform) == "unix"} {
+	catch {set user [exec whoami]}
+	if {$user == ""} {
+	    catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+	}
+	if {($user == "root") || ($user == "")} {
+	    set ::tcltest::testConfig(root) 1
+	    set ::tcltest::testConfig(notRoot) 0
+	}
+    }
+
+    # Set nonBlockFiles constraint: 1 means this platform supports
+    # setting files into nonblocking mode.
+    if {[catch {set f [open defs r]}]} {
+	set ::tcltest::testConfig(nonBlockFiles) 1
+    } else {
+	if {[catch {fconfigure $f -blocking off}] == 0} {
+	    set ::tcltest::testConfig(nonBlockFiles) 1
+	} else {
+	    set ::tcltest::testConfig(nonBlockFiles) 0
+	}
+	close $f
+    }
+
+    # Set asyncPipeClose constraint: 1 means this platform supports
+    # async flush and async close on a pipe.
+    #
+    # Test for SCO Unix - cannot run async flushing tests because a
+    # potential problem with select is apparently interfering.
+    # (Mark Diekhans).
+    if {$tcl_platform(platform) == "unix"} {
+	if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
+	    set ::tcltest::testConfig(asyncPipeClose) 0
+	} else {
+	    set ::tcltest::testConfig(asyncPipeClose) 1
+	}
+    } else {
+	set ::tcltest::testConfig(asyncPipeClose) 1
+    }
+
+    # Test to see if we have a broken version of sprintf with respect
+    # to the "e" format of floating-point numbers.
+    set ::tcltest::testConfig(eformat) 1
+    if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
+	set ::tcltest::testConfig(eformat) 0
+    }
+
+    # Test to see if execed commands such as cat, echo, rm and so forth are
+    # present on this machine.
+    set ::tcltest::testConfig(unixExecs) 1
+    if {$tcl_platform(platform) == "macintosh"} {
+	set ::tcltest::testConfig(unixExecs) 0
+    }
+    if {($::tcltest::testConfig(unixExecs) == 1) && \
+	    ($tcl_platform(platform) == "windows")} {
+	if {[catch {exec cat defs}] == 1} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	}
+	if {($::tcltest::testConfig(unixExecs) == 1) && \
+		([catch {exec echo hello}] == 1)} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	}
+	if {($::tcltest::testConfig(unixExecs) == 1) && \
+		([catch {exec sh -c echo hello}] == 1)} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	}
+	if {($::tcltest::testConfig(unixExecs) == 1) && \
+		([catch {exec wc defs}] == 1)} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	}
+	if {$::tcltest::testConfig(unixExecs) == 1} {
+	    exec echo hello > removeMe
+	    if {[catch {exec rm removeMe}] == 1} {
+		set ::tcltest::testConfig(unixExecs) 0
+	    }
+	}
+	if {($::tcltest::testConfig(unixExecs) == 1) && \
+		([catch {exec sleep 1}] == 1)} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	}
+	if {($::tcltest::testConfig(unixExecs) == 1) && \
+		([catch {exec fgrep unixExecs defs}] == 1)} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	}
+	if {($::tcltest::testConfig(unixExecs) == 1) && \
+		([catch {exec ps}] == 1)} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	}
+	if {($::tcltest::testConfig(unixExecs) == 1) && \
+		([catch {exec echo abc > removeMe}] == 0) && \
+		([catch {exec chmod 644 removeMe}] == 1) && \
+		([catch {exec rm removeMe}] == 0)} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	} else {
+	    catch {exec rm -f removeMe}
+	}
+	if {($::tcltest::testConfig(unixExecs) == 1) && \
+		([catch {exec mkdir removeMe}] == 1)} {
+	    set ::tcltest::testConfig(unixExecs) 0
+	} else {
+	    catch {exec rm -r removeMe}
+	}
+    }
+}
+
+::tcltest::initConfig
+
+
+# ::tcltest::processCmdLineArgs --
+#
+#	Use command line args to set the verbose, skip, and
+#	match variables.  This procedure must be run after
+#	constraints are initialized, because some constraints can be
+#	overridden.
+#
+# Arguments:
+#	none
+#
+# Results:
+#	::tcltest::verbose is set to <value>
+
+proc ::tcltest::processCmdLineArgs {} {
+    global argv
+
+    # The "argv" var doesn't exist in some cases, so use {}
+    # The "argv" var doesn't exist in some cases.
+    if {(![info exists argv]) || ([llength $argv] < 2)} {
+	set flagArray {}
+    } else {
+	set flagArray $argv
+    }
+
+    if {[catch {array set flag $flagArray}]} {
+	puts stderr "Error:  odd number of command line args specified:"
+	puts stderr "        $argv"
+	exit
+    }
+    
+    # Allow for 1-char abbreviations, where applicable (e.g., -match == -m).
+    # Note that -verbose cannot be abbreviated to -v in wish because it
+    # conflicts with the wish option -visual.
+    foreach arg {-verbose -match -skip -constraints} {
+	set abbrev [string range $arg 0 1]
+	if {([info exists flag($abbrev)]) && \
+		([lsearch -exact $flagArray $arg] < \
+		[lsearch -exact $flagArray $abbrev])} {
+	    set flag($arg) $flag($abbrev)
+	}
+    }
+
+    # Set ::tcltest::workingDir to [pwd].
+    # Save the names of files that already exist in ::tcltest::workingDir.
+    set ::tcltest::workingDir [pwd]
+    foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
+	lappend ::tcltest::filesExisted [file tail $file]
+    }
+
+    # Set ::tcltest::verbose to the arg of the -verbose flag, if given
+    if {[info exists flag(-verbose)]} {
+	set ::tcltest::verbose $flag(-verbose)
+    }
+
+    # Set ::tcltest::match to the arg of the -match flag, if given
+    if {[info exists flag(-match)]} {
+	set ::tcltest::match $flag(-match)
+    }
+
+    # Set ::tcltest::skip to the arg of the -skip flag, if given
+    if {[info exists flag(-skip)]} {
+	set ::tcltest::skip $flag(-skip)
+    }
+
+    # Use the -constraints flag, if given, to turn on constraints that are
+    # turned off by default: userInteractive knownBug nonPortable.  This
+    # code fragment must be run after constraints are initialized.
+    if {[info exists flag(-constraints)]} {
+	foreach elt $flag(-constraints) {
+	    set ::tcltest::testConfig($elt) 1
+	}
+    }
+}
+
+::tcltest::processCmdLineArgs
+
+
+# ::tcltest::cleanupTests --
+#
+# Remove files and dirs created using the makeFile and makeDirectory
+# commands since the last time this proc was invoked.
+#
+# Print the names of the files created without the makeFile command
+# since the tests were invoked.
+#
+# Print the number tests (total, passed, failed, and skipped) since the
+# tests were invoked.
+#
+
+proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
+    set tail [file tail [info script]]
+
+    # Remove files and directories created by the :tcltest::makeFile and
+    # ::tcltest::makeDirectory procedures.
+    # Record the names of files in ::tcltest::workingDir that were not
+    # pre-existing, and associate them with the test file that created them.
+    if {!$calledFromAllFile} {
+
+	foreach file $::tcltest::filesMade {
+	    if {[file exists $file]} {
+		catch {file delete -force $file}
+	    }
+	}
+	set currentFiles {}
+	foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
+	    lappend currentFiles [file tail $file]
+	}
+	set newFiles {}
+	foreach file $currentFiles {
+	    if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
+		lappend newFiles $file
+	    }
+	}
+	set ::tcltest::filesExisted $currentFiles
+	if {[llength $newFiles] > 0} {
+	    set ::tcltest::createdNewFiles($tail) $newFiles
+	}
+    }
+
+    if {$calledFromAllFile || $::tcltest::testSingleFile} {
+	# print stats
+	puts -nonewline stdout "$tail:"
+	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+	    puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)"
+	}
+	puts stdout ""
+
+	# print number test files sourced
+	# print names of files that ran tests which failed
+	if {$calledFromAllFile} {
+	    puts stdout "Sourced $::tcltest::numTestFiles Test Files."
+	    set ::tcltest::numTestFiles 0
+	    if {[llength $::tcltest::failFiles] > 0} {
+		puts stdout "Files with failing tests: $::tcltest::failFiles"
+		set ::tcltest::failFiles {}
+	    }
+	}
+
+	# if any tests were skipped, print the constraints that kept them
+	# from running.
+	set constraintList [array names ::tcltest::skippedBecause]
+	if {[llength $constraintList] > 0} {
+	    puts stdout "Number of tests skipped for each constraint:"
+	    foreach constraint [lsort $constraintList] {
+		puts stdout \
+			"\t$::tcltest::skippedBecause($constraint)\t$constraint"
+		unset ::tcltest::skippedBecause($constraint)
+	    }
+	}
+
+	# report the names of test files in ::tcltest::createdNewFiles, and
+	# reset the array to be empty.
+	set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]]
+	if {[llength $testFilesThatTurded] > 0} {
+	    puts stdout "Warning: test files left files behind:"
+	    foreach testFile $testFilesThatTurded {
+		puts "\t$testFile:\t$::tcltest::createdNewFiles($testFile)"
+		unset ::tcltest::createdNewFiles($testFile)
+	    }
+	}
+
+	# reset filesMade, filesExisted, and numTests
+	set ::tcltest::filesMade {}
+	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+	    set ::tcltest::numTests($index) 0
+	}
+
+	# exit only if running Tk in non-interactive mode
+	global tk_version tcl_interactive
+	if {[info exists tk_version] && !$tcl_interactive} {
+	    exit
+	}
+    } else {
+	# if we're deferring stat-reporting until all files are sourced,
+	# then add current file to failFile list if any tests in this file
+	# failed
+	incr ::tcltest::numTestFiles
+	if {($::tcltest::currentFailure) && \
+		([lsearch -exact $::tcltest::failFiles $tail] == -1)} {
+	    lappend ::tcltest::failFiles $tail
+	}
+	set ::tcltest::currentFailure false
+    }
+}
+
+
+# test --
+#
+# This procedure runs a test and prints an error message if the test fails.
+# If ::tcltest::verbose has been set, it also prints a message even if the
+# test succeeds.  The test will be skipped if it doesn't match the
+# ::tcltest::match variable, if it matches an element in
+# ::tcltest::skip, or if one of the elements of "constraints" turns
+# out not to be true.
+#
+# Arguments:
+# name -		Name of test, in the form foo-1.2.
+# description -		Short textual description of the test, to
+#			help humans understand what it does.
+# constraints -		A list of one or more keywords, each of
+#			which must be the name of an element in
+#			the array "::tcltest::testConfig".  If any of these
+#			elements is zero, the test is skipped.
+#			This argument may be omitted.
+# script -		Script to run to carry out the test.  It must
+#			return a result that can be checked for
+#			correctness.
+# expectedAnswer -	Expected result from script.
+
+proc ::tcltest::test {name description script expectedAnswer args} {
+    incr ::tcltest::numTests(Total)
+
+    # skip the test if it's name matches an element of skip
+    foreach pattern $::tcltest::skip {
+	if {[string match $pattern $name]} {
+	    incr ::tcltest::numTests(Skipped)
+	    return
+	}
+    }
+    # skip the test if it's name doesn't match any element of match
+    if {[llength $::tcltest::match] > 0} {
+	set ok 0
+	foreach pattern $::tcltest::match {
+	    if {[string match $pattern $name]} {
+		set ok 1
+		break
+	    }
+        }
+	if {!$ok} {
+	    incr ::tcltest::numTests(Skipped)
+	    return
+	}
+    }
+    set i [llength $args]
+    if {$i == 0} {
+	set constraints {}
+    } elseif {$i == 1} {
+	# "constraints" argument exists;  shuffle arguments down, then
+	# make sure that the constraints are satisfied.
+
+	set constraints $script
+	set script $expectedAnswer
+	set expectedAnswer [lindex $args 0]
+	set doTest 0
+	if {[string match {*[$\[]*} $constraints] != 0} {
+	    # full expression, e.g. {$foo > [info tclversion]}
+
+	    catch {set doTest [uplevel #0 expr $constraints]}
+	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
+	    # something like {a || b} should be turned into 
+	    # $::tcltest::testConfig(a) || $::tcltest::testConfig(b).
+
+ 	    regsub -all {[.a-zA-Z0-9]+} $constraints \
+		    {$::tcltest::testConfig(&)} c
+	    catch {set doTest [eval expr $c]}
+	} else {
+	    # just simple constraints such as {unixOnly fonts}.
+
+	    set doTest 1
+	    foreach constraint $constraints {
+		if {![info exists ::tcltest::testConfig($constraint)]
+			|| !$::tcltest::testConfig($constraint)} {
+		    set doTest 0
+		    # store the constraint that kept the test from running
+		    set constraints $constraint
+		    break
+		}
+	    }
+	}
+	if {$doTest == 0} {
+	    incr ::tcltest::numTests(Skipped)
+	    if {[string first s $::tcltest::verbose] != -1} {
+		puts stdout "++++ $name SKIPPED: $constraints"
+	    }
+	    # add the constraint to the list of constraints the kept tests
+	    # from running
+	    if {[info exists ::tcltest::skippedBecause($constraints)]} {
+		incr ::tcltest::skippedBecause($constraints)
+	    } else {
+		set ::tcltest::skippedBecause($constraints) 1
+	    }
+	    return	
+	}
+    } else {
+	error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\""
+    }
+    memory tag $name
+    set code [catch {uplevel $script} actualAnswer]
+    if {$code != 0 || [string compare $actualAnswer $expectedAnswer] != 0} {
+	incr ::tcltest::numTests(Failed)
+	set ::tcltest::currentFailure true
+	if {[string first b $::tcltest::verbose] == -1} {
+	    set script ""
+	}
+	puts stdout "\n==== $name $description FAILED"
+	if {$script != ""} {
+	    puts stdout "==== Contents of test case:"
+	    puts stdout $script
+	}
+	if {$code != 0} {
+	    if {$code == 1} {
+		puts stdout "==== Test generated error:"
+		puts stdout $actualAnswer
+	    } elseif {$code == 2} {
+		puts stdout "==== Test generated return exception;  result was:"
+		puts stdout $actualAnswer
+	    } elseif {$code == 3} {
+		puts stdout "==== Test generated break exception"
+	    } elseif {$code == 4} {
+		puts stdout "==== Test generated continue exception"
+	    } else {
+		puts stdout "==== Test generated exception $code;  message was:"
+		puts stdout $actualAnswer
+	    }
+	} else {
+	    puts stdout "---- Result was:\n$actualAnswer"
+	}
+	puts stdout "---- Result should have been:\n$expectedAnswer"
+	puts stdout "==== $name FAILED\n" 
+    } else { 
+	incr ::tcltest::numTests(Passed)
+	if {[string first p $::tcltest::verbose] != -1} {
+	    puts stdout "++++ $name PASSED"
+	}
+    }
+}
+
+# ::tcltest::dotests --
+#
+#	takes two arguments--the name of the test file (such
+#	as "parse.test"), and a pattern selecting the tests you want to
+#	execute.  It sets ::tcltest::matching to the second argument, calls
+#	"source" on the file specified in the first argument, and restores
+#	::tcltest::matching to its pre-call value at the end.
+#
+# Arguments:
+#	file    name of tests file to source
+#	args    pattern selecting the tests you want to execute
+#
+# Results:
+#	none
+
+proc ::tcltest::dotests {file args} {
+    set savedTests $::tcltest::match
+    set ::tcltest::match $args
+    source $file
+    set ::tcltest::match $savedTests
+}
+
+proc ::tcltest::openfiles {} {
+    if {[catch {testchannel open} result]} {
+	return {}
+    }
+    return $result
+}
+
+proc ::tcltest::leakfiles {old} {
+    if {[catch {testchannel open} new]} {
+        return {}
+    }
+    set leak {}
+    foreach p $new {
+    	if {[lsearch $old $p] < 0} {
+	    lappend leak $p
+	}
+    }
+    return $leak
+}
+
+set ::tcltest::saveState {}
+
+proc ::tcltest::saveState {} {
+    uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]}
+}
+
+proc ::tcltest::restoreState {} {
+    foreach p [info procs] {
+	if {[lsearch [lindex $::tcltest::saveState 0] $p] < 0} {
+	    rename $p {}
+	}
+    }
+    foreach p [uplevel #0 {info vars}] {
+	if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} {
+	    uplevel #0 "unset $p"
+	}
+    }
+}
+
+proc ::tcltest::normalizeMsg {msg} {
+    regsub "\n$" [string tolower $msg] "" msg
+    regsub -all "\n\n" $msg "\n" msg
+    regsub -all "\n\}" $msg "\}" msg
+    return $msg
+}
+
+# makeFile --
+#
+# Create a new file with the name <name>, and write <contents> to it.
+#
+# If this file hasn't been created via makeFile since the last time
+# cleanupTests was called, add it to the $filesMade list, so it will
+# be removed by the next call to cleanupTests.
+#
+proc ::tcltest::makeFile {contents name} {
+    set fd [open $name w]
+    fconfigure $fd -translation lf
+    if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} {
+	puts -nonewline $fd $contents
+    } else {
+	puts $fd $contents
+    }
+    close $fd
+
+    set fullName [file join [pwd] $name]
+    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
+	lappend ::tcltest::filesMade $fullName
+    }
+}
+
+proc ::tcltest::removeFile {name} {
+    file delete $name
+}
+
+# makeDirectory --
+#
+# Create a new dir with the name <name>.
+#
+# If this dir hasn't been created via makeDirectory since the last time
+# cleanupTests was called, add it to the $directoriesMade list, so it will
+# be removed by the next call to cleanupTests.
+#
+proc ::tcltest::makeDirectory {name} {
+    file mkdir $name
+
+    set fullName [file join [pwd] $name]
+    if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
+	lappend ::tcltest::filesMade $fullName
+    }
+}
+
+proc ::tcltest::removeDirectory {name} {
+    file delete -force $name
+}
+
+proc ::tcltest::viewFile {name} {
+    global tcl_platform
+    if {($tcl_platform(platform) == "macintosh") || \
+		($::tcltest::testConfig(unixExecs) == 0)} {
+	set f [open $name]
+	set data [read -nonewline $f]
+	close $f
+	return $data
+    } else {
+	exec cat $name
+    }
+}
+
+#
+# Construct a string that consists of the requested sequence of bytes,
+# as opposed to a string of properly formed UTF-8 characters.  
+# This allows the tester to 
+# 1. Create denormalized or improperly formed strings to pass to C procedures 
+#    that are supposed to accept strings with embedded NULL bytes.
+# 2. Confirm that a string result has a certain pattern of bytes, for instance
+#    to confirm that "\xe0\0" in a Tcl script is stored internally in 
+#    UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
+#
+# Generally, it's a bad idea to examine the bytes in a Tcl string or to
+# construct improperly formed strings in this manner, because it involves
+# exposing that Tcl uses UTF-8 internally.
+
+proc ::tcltest::bytestring {string} {
+    encoding convertfrom identity $string
+}
+
+# Locate tcltest executable
+
+if {![info exists tk_version]} {
+    set tcltest [info nameofexecutable]
+
+    if {$tcltest == "{}"} {
+	set tcltest {}
+    }
+}
+
+set ::tcltest::testConfig(stdio) 0
+catch {
+    catch {file delete -force tmp}
+    set f [open tmp w]
+    puts $f {
+	exit
+    }
+    close $f
+
+    set f [open "|[list $tcltest tmp]" r]
+    close $f
+    
+    set ::tcltest::testConfig(stdio) 1
+}
+catch {file delete -force tmp}
+
+# Deliberately call the socket with the wrong number of arguments.  The error
+# message you get will indicate whether sockets are available on this system.
+catch {socket} msg
+set ::tcltest::testConfig(socket) \
+	[expr {$msg != "sockets are not available on this system"}]
+
+#
+# Internationalization / ISO support procs     -- dl
+#
+if {[info commands testlocale]==""} {
+    # No testlocale command, no tests...
+    # (it could be that we are a sub interp and we could just load
+    # the Tcltest package but that would interfere with tests
+    # that tests packages/loading in slaves...)
+    set ::tcltest::testConfig(hasIsoLocale) 0
+} else {
+    proc ::tcltest::set_iso8859_1_locale {} {
+	set ::tcltest::previousLocale [testlocale ctype]
+	testlocale ctype $::tcltest::isoLocale
+    }
+
+    proc ::tcltest::restore_locale {} {
+	testlocale ctype $::tcltest::previousLocale
+    }
+
+    if {![info exists ::tcltest::isoLocale]} {
+	set ::tcltest::isoLocale fr
+        switch $tcl_platform(platform) {
+	    "unix" {
+		# Try some 'known' values for some platforms:
+		switch -exact -- $tcl_platform(os) {
+		    "FreeBSD" {
+			set ::tcltest::isoLocale fr_FR.ISO_8859-1
+		    }
+		    HP-UX {
+			set ::tcltest::isoLocale fr_FR.iso88591
+		    }
+		    Linux -
+		    IRIX {
+			set ::tcltest::isoLocale fr
+		    }
+		    default {
+			# Works on SunOS 4 and Solaris, and maybe others...
+			# define it to something else on your system
+			#if you want to test those.
+			set ::tcltest::isoLocale iso_8859_1
+		    }
+		}
+	    }
+	    "windows" {
+		set ::tcltest::isoLocale French
+	    }
+	}
+    }
+
+    set ::tcltest::testConfig(hasIsoLocale) \
+	    [string length [::tcltest::set_iso8859_1_locale]]
+    ::tcltest::restore_locale
+} 
+
+#
+# procedures that are Tk specific
+#
+if {[info exists tk_version]} {
+    # If the main window isn't already mapped (e.g. because the tests are
+    # being run automatically) , specify a precise size for it so that the
+    # user won't have to position it manually.
+
+    if {![winfo ismapped .]} {
+	wm geometry . +0+0
+	update
+    }
+
+    # The following code can be used to perform tests involving a second
+    # process running in the background.
+    
+    # Locate the tktest executable
+
+    set ::tcltest::tktest [info nameofexecutable]
+    if {$::tcltest::tktest == "{}"} {
+	set ::tcltest::tktest {}
+	puts stdout \
+		"Unable to find tktest executable, skipping multiple process tests."
+    }
+
+    # Create background process
+    
+    proc ::tcltest::setupbg args {
+	if {$::tcltest::tktest == ""} {
+	    error "you're not running tktest so setupbg should not have been called"
+	}
+	if {[info exists ::tcltest::fd] && ($::tcltest::fd != "")} {
+	    cleanupbg
+	}
+	
+	# The following code segment cannot be run on Windows in Tk8.1b2
+	# This bug is logged as a pipe bug (bugID 1495).
+
+	global tcl_platform
+	if {$tcl_platform(platform) != "windows"} {
+	    set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+]
+	    puts $::tcltest::fd "puts foo; flush stdout"
+	    flush $::tcltest::fd
+	    if {[gets $::tcltest::fd data] < 0} {
+		error "unexpected EOF from \"$::tcltest::tktest\""
+	    }
+	    if {[string compare $data foo]} {
+		error "unexpected output from background process \"$data\""
+	    }
+	    fileevent $::tcltest::fd readable bgReady
+	}
+    }
+    
+    # Send a command to the background process, catching errors and
+    # flushing I/O channels
+    proc ::tcltest::dobg {command} {
+	puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout"
+	flush $::tcltest::fd
+	set ::tcltest::bgDone 0
+	set ::tcltest::bgData {}
+	tkwait variable ::tcltest::bgDone
+	set ::tcltest::bgData
+    }
+
+    # Data arrived from background process.  Check for special marker
+    # indicating end of data for this command, and make data available
+    # to dobg procedure.
+    proc ::tcltest::bgReady {} {
+	set x [gets $::tcltest::fd]
+	if {[eof $::tcltest::fd]} {
+	    fileevent $::tcltest::fd readable {}
+	    set ::tcltest::bgDone 1
+	} elseif {$x == "**DONE**"} {
+	    set ::tcltest::bgDone 1
+	} else {
+	    append ::tcltest::bgData $x
+	}
+    }
+
+    # Exit the background process, and close the pipes
+    proc ::tcltest::cleanupbg {} {
+	catch {
+	    puts $::tcltest::fd "exit"
+	    close $::tcltest::fd
+	}
+	set ::tcltest::fd ""
+    }
+
+    # Clean up focus after using generate event, which
+    # can leave the window manager with the wrong impression
+    # about who thinks they have the focus. (BW)
+    
+    proc ::tcltest::fixfocus {} {
+	catch {destroy .focus}
+	toplevel .focus
+	wm geometry .focus +0+0
+	entry .focus.e
+	.focus.e insert 0 "fixfocus"
+	pack .focus.e
+	update
+	focus -force .focus.e
+	destroy .focus
+    }
+}
+
+# Need to catch the import because it fails if defs.tcl is sourced
+# more than once.
+catch {namespace import ::tcltest::*}
+return
diff --git a/tests/entry.test b/tests/entry.test
index 551404c..107df62 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -3,23 +3,23 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: entry.test,v 1.2 1998/09/14 18:23:45 stanton Exp $
+# RCS: @(#) $Id: entry.test,v 1.3 1999/04/16 01:51:37 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\""
     puts "image, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 foreach i [winfo children .] {
     destroy $i
 }
@@ -51,6 +51,7 @@ option add *Entry.font {Helvetica -12}
 entry .e -bd 2 -relief sunken
 pack .e
 update
+
 set i 1
 foreach test {
     {-background #ff0000 #ff0000 non-existent
@@ -74,25 +75,25 @@ foreach test {
     {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
     {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
     {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
-    {-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 "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"}}
     {-show * * {} {}}
-    {-state normal normal bogus {bad state value "bogus": must be normal or disabled}}
+    {-state normal normal bogus {bad state "bogus": must be disabled or normal}}
     {-takefocus "any string" "any string" {} {}}
     {-textvariable i i {} {}}
     {-width 402 402 3p {expected integer but got "3p"}}
     {-xscrollcommand {Some command} {Some command} {} {}}
 } {
     set name [lindex $test 0]
-    test entry-1.1 {configuration options} {
+    test entry-1.$i {configuration options} {
 	.e configure $name [lindex $test 1]
 	list [lindex [.e configure $name] 4] [.e cget $name]
     } [list [lindex $test 2] [lindex $test 2]]
     incr i
     if {[lindex $test 3] != ""} {
-	test entry-1.2 {configuration options} {
+	test entry-1.$i {configuration options} {
 	    list [catch {.e configure $name [lindex $test 3]} msg] $msg
 	} [list 1 [lindex $test 4]]
     }
@@ -128,6 +129,7 @@ update
 
 set cx [font measure $fixed a]
 set cy [font metrics $fixed -linespace]
+set ux [font measure $fixed \u4e4e]
 
 test entry-3.1 {EntryWidgetCmd procedure} {
     list [catch {.e} msg] $msg
@@ -145,66 +147,106 @@ test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} {
     .e delete 0 end
     .e bbox 0
 } [list 5 5 0 $cy]
-test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {fonts} {
+test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {
+    # Tcl_UtfAtIndex(): no utf chars
+
     .e delete 0 end
-    .e insert 0 "abcdefghijklmnop"
-    list [.e bbox 0] [.e bbox 1] [.e bbox end]
-} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+15*$cx] 5 $cx $cy"]
-test entry-3.7 {EntryWidgetCmd procedure, "cget" widget command} {
+    .e insert 0 "abc"
+    list [.e bbox 3] [.e bbox end]
+} [list "[expr 5+2*$cx] 5 $cx $cy" "[expr 5+2*$cx] 5 $cx $cy"]
+test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} {
+    # Tcl_UtfAtIndex(): utf at end
+    .e delete 0 end
+    .e insert 0 "ab\u4e4e"
+    .e bbox end
+} "[expr 5+2*$cx] 5 $ux $cy"
+test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} {
+    # Tcl_UtfAtIndex(): utf before index
+    .e delete 0 end
+    .e insert 0 "ab\u4e4ec"
+    .e bbox 3
+} "[expr 5+2*$cx+$ux] 5 $cx $cy"
+test entry-3.9 {EntryWidgetCmd procedure, "bbox" widget command} {
+    # Tcl_UtfAtIndex(): no chars
+    .e delete 0 end
+    .e bbox end
+} "5 5 0 $cy"
+test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} {
+    .e delete 0 end
+    .e insert 0 "abcdefghij\u4e4eklmnop"
+    list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
+} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+10*$cx] 5 $ux $cy" "[expr 5+$ux+15*$cx] 5 $cx $cy"]
+test entry-3.11 {EntryWidgetCmd procedure, "cget" widget command} {
     list [catch {.e cget} msg] $msg
 } {1 {wrong # args: should be ".e cget option"}}
-test entry-3.8 {EntryWidgetCmd procedure, "cget" widget command} {
+test entry-3.12 {EntryWidgetCmd procedure, "cget" widget command} {
     list [catch {.e cget a b} msg] $msg
 } {1 {wrong # args: should be ".e cget option"}}
-test entry-3.9 {EntryWidgetCmd procedure, "cget" widget command} {
+test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} {
     list [catch {.e cget -gorp} msg] $msg
 } {1 {unknown option "-gorp"}}
-test entry-3.10 {EntryWidgetCmd procedure, "cget" widget command} {
+test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} {
     .e configure -bd 4
     .e cget -bd
 } {4}
-test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} {
+test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} {
     llength [.e configure]
 } {28}
-test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} {
+test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} {
     list [catch {.e configure -foo} msg] $msg
 } {1 {unknown option "-foo"}}
-test entry-3.13 {EntryWidgetCmd procedure, "configure" widget command} {
+test entry-3.17 {EntryWidgetCmd procedure, "configure" widget command} {
     .e configure -bd 4
     .e configure -bg #ffffff
     lindex [.e configure -bd] 4
 } {4}
-test entry-3.14 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} {
     list [catch {.e delete} msg] $msg
 } {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
-test entry-3.15 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} {
     list [catch {.e delete a b c} msg] $msg
 } {1 {wrong # args: should be ".e delete firstIndex ?lastIndex?"}}
-test entry-3.16 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
     list [catch {.e delete foo} msg] $msg
 } {1 {bad entry index "foo"}}
-test entry-3.17 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
     list [catch {.e delete 0 bar} msg] $msg
 } {1 {bad entry index "bar"}}
-test entry-3.18 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.22 {EntryWidgetCmd procedure, "delete" widget command} {
     .e delete 0 end
     .e insert end "01234567890"
     .e delete 2 4
     .e get
 } {014567890}
-test entry-3.19 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.23 {EntryWidgetCmd procedure, "delete" widget command} {
     .e delete 0 end
     .e insert end "01234567890"
     .e delete 6
     .e get
 } {0123457890}
-test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} {
+    # UTF
+    set x {}
+    .e delete 0 end
+    .e insert end "01234\u4e4e67890"
+    .e delete 6
+    lappend x [.e get]
+    .e delete 0 end
+    .e insert end "012345\u4e4e7890"
+    .e delete 6
+    lappend x [.e get]
+    .e delete 0 end
+    .e insert end "0123456\u4e4e890"
+    .e delete 6
+    lappend x [.e get]
+} [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
+test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} {
     .e delete 0 end
     .e insert end "01234567890"
     .e delete 6 5
     .e get
 } {01234567890}
-test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} {
     .e delete 0 end
     .e insert end "01234567890"
     .e configure -state disabled
@@ -212,49 +254,55 @@ test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
     .e configure -state normal
     .e get
 } {01234567890}
-test entry-3.22 {EntryWidgetCmd procedure, "get" widget command} {
+test entry-3.27 {EntryWidgetCmd procedure, "get" widget command} {
     list [catch {.e get foo} msg] $msg
 } {1 {wrong # args: should be ".e get"}}
-test entry-3.23 {EntryWidgetCmd procedure, "icursor" widget command} {
+test entry-3.28 {EntryWidgetCmd procedure, "icursor" widget command} {
     list [catch {.e icursor} msg] $msg
 } {1 {wrong # args: should be ".e icursor pos"}}
-test entry-3.24 {EntryWidgetCmd procedure, "icursor" widget command} {
+test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} {
     list [catch {.e icursor foo} msg] $msg
 } {1 {bad entry index "foo"}}
-test entry-3.25 {EntryWidgetCmd procedure, "icursor" widget command} {
+test entry-3.30 {EntryWidgetCmd procedure, "icursor" widget command} {
     .e delete 0 end
     .e insert end "01234567890"
     .e icursor 4
     .e index insert
 } {4}
-test entry-3.26 {EntryWidgetCmd procedure, "index" widget command} {
+test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} {
     list [catch {.e in} msg] $msg
-} {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
-test entry-3.27 {EntryWidgetCmd procedure, "index" widget command} {
+} {1 {ambiguous option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
+test entry-3.32 {EntryWidgetCmd procedure, "index" widget command} {
     list [catch {.e index} msg] $msg
 } {1 {wrong # args: should be ".e index string"}}
-test entry-3.28 {EntryWidgetCmd procedure, "index" widget command} {
+test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} {
     list [catch {.e index foo} msg] $msg
 } {1 {bad entry index "foo"}}
-test entry-3.29 {EntryWidgetCmd procedure, "index" widget command} {
+test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} {
     list [catch {.e index 0} msg] $msg
 } {0 0}
-test entry-3.30 {EntryWidgetCmd procedure, "insert" widget command} {
+test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} {
+    # UTF
+    .e delete 0 end
+    .e insert 0 abc\u4e4e\u0153def
+    list [.e index 3] [.e index 4] [.e index end]
+} {3 4 8}
+test entry-3.36 {EntryWidgetCmd procedure, "insert" widget command} {
     list [catch {.e insert a} msg] $msg
 } {1 {wrong # args: should be ".e insert index text"}}
-test entry-3.31 {EntryWidgetCmd procedure, "insert" widget command} {
+test entry-3.37 {EntryWidgetCmd procedure, "insert" widget command} {
     list [catch {.e insert a b c} msg] $msg
 } {1 {wrong # args: should be ".e insert index text"}}
-test entry-3.32 {EntryWidgetCmd procedure, "insert" widget command} {
+test entry-3.38 {EntryWidgetCmd procedure, "insert" widget command} {
     list [catch {.e insert foo Text} msg] $msg
 } {1 {bad entry index "foo"}}
-test entry-3.33 {EntryWidgetCmd procedure, "insert" widget command} {
+test entry-3.39 {EntryWidgetCmd procedure, "insert" widget command} {
     .e delete 0 end
     .e insert end "01234567890"
     .e insert 3 xxx
     .e get
 } {012xxx34567890}
-test entry-3.34 {EntryWidgetCmd procedure, "insert" widget command} {
+test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} {
     .e delete 0 end
     .e insert end "01234567890"
     .e configure -state disabled
@@ -262,24 +310,24 @@ test entry-3.34 {EntryWidgetCmd procedure, "insert" widget command} {
     .e configure -state normal
     .e get
 } {01234567890}
-test entry-3.35 {EntryWidgetCmd procedure, "insert" widget command} {
+test entry-3.41 {EntryWidgetCmd procedure, "insert" widget command} {
     list [catch {.e insert a b c} msg] $msg
 } {1 {wrong # args: should be ".e insert index text"}}
-test entry-3.36 {EntryWidgetCmd procedure, "scan" widget command} {
+test entry-3.42 {EntryWidgetCmd procedure, "scan" widget command} {
     list [catch {.e scan a} msg] $msg
 } {1 {wrong # args: should be ".e scan mark|dragto x"}}
-test entry-3.37 {EntryWidgetCmd procedure, "scan" widget command} {
+test entry-3.43 {EntryWidgetCmd procedure, "scan" widget command} {
     list [catch {.e scan a b c} msg] $msg
 } {1 {wrong # args: should be ".e scan mark|dragto x"}}
-test entry-3.38 {EntryWidgetCmd procedure, "scan" widget command} {
+test entry-3.44 {EntryWidgetCmd procedure, "scan" widget command} {
     list [catch {.e scan foobar 20} msg] $msg
 } {1 {bad scan option "foobar": must be mark or dragto}}
-test entry-3.39 {EntryWidgetCmd procedure, "scan" widget command} {
+test entry-3.45 {EntryWidgetCmd procedure, "scan" widget command} {
     list [catch {.e scan mark 20.1} msg] $msg
 } {1 {expected integer but got "20.1"}}
 # This test is non-portable because character sizes vary.
 
-test entry-3.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
+test entry-3.46 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
     .e delete 0 end
     update
     .e insert end "This is quite a long string, in fact a "
@@ -288,16 +336,16 @@ test entry-3.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
     .e scan dragto 28
     .e index @0
 } {2}
-test entry-3.41 {EntryWidgetCmd procedure, "select" widget command} {
+test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} {
     list [catch {.e select} msg] $msg
 } {1 {wrong # args: should be ".e select option ?index?"}}
-test entry-3.42 {EntryWidgetCmd procedure, "select" widget command} {
+test entry-3.48 {EntryWidgetCmd procedure, "select" widget command} {
     list [catch {.e select foo} msg] $msg
 } {1 {bad selection option "foo": must be adjust, clear, from, present, range, or to}}
-test entry-3.43 {EntryWidgetCmd procedure, "select clear" widget command} {
+test entry-3.49 {EntryWidgetCmd procedure, "select clear" widget command} {
     list [catch {.e select clear gorp} msg] $msg
 } {1 {wrong # args: should be ".e selection clear"}}
-test entry-3.44 {EntryWidgetCmd procedure, "select clear" widget command} {
+test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} {
     .e delete 0 end
     .e insert end "0123456789"
     .e select from 1
@@ -306,17 +354,17 @@ test entry-3.44 {EntryWidgetCmd procedure, "select clear" widget command} {
     .e select clear
     list [catch {selection get} msg] $msg [selection own]
 } {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
-test entry-3.45 {EntryWidgetCmd procedure, "selection present" widget command} {
+test entry-3.51 {EntryWidgetCmd procedure, "selection present" widget command} {
     list [catch {.e selection present foo} msg] $msg
 } {1 {wrong # args: should be ".e selection present"}}
-test entry-3.46 {EntryWidgetCmd procedure, "selection present" widget command} {
+test entry-3.52 {EntryWidgetCmd procedure, "selection present" widget command} {
     .e delete 0 end
     .e insert end 0123456789
     .e select from 3
     .e select to 6
     .e selection present
 } {1}
-test entry-3.47 {EntryWidgetCmd procedure, "selection present" widget command} {
+test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} {
     .e delete 0 end
     .e insert end 0123456789
     .e select from 3
@@ -325,7 +373,7 @@ test entry-3.47 {EntryWidgetCmd procedure, "selection present" widget command} {
     .e selection present
 } {1}
 .e configure -exportselection true
-test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} {
+test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} {
     .e delete 0 end
     .e insert end 0123456789
     .e select from 3
@@ -333,13 +381,13 @@ test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} {
     .e delete 0 end
     .e selection present
 } {0}
-test entry-3.49 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+test entry-3.55 {EntryWidgetCmd procedure, "selection adjust" widget command} {
     list [catch {.e select adjust x} msg] $msg
 } {1 {bad entry index "x"}}
-test entry-3.50 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+test entry-3.56 {EntryWidgetCmd procedure, "selection adjust" widget command} {
     list [catch {.e select adjust 2 3} msg] $msg
 } {1 {wrong # args: should be ".e selection adjust index"}}
-test entry-3.51 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} {
     .e delete 0 end
     .e insert end "0123456789"
     .e select from 1
@@ -348,7 +396,7 @@ test entry-3.51 {EntryWidgetCmd procedure, "selection adjust" widget command} {
     .e select adjust 4
     selection get
 } {123}
-test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} {
     .e delete 0 end
     .e insert end "0123456789"
     .e select from 1
@@ -357,16 +405,16 @@ test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} {
     .e select adjust 2
     selection get
 } {234}
-test entry-3.53 {EntryWidgetCmd procedure, "selection from" widget command} {
+test entry-3.59 {EntryWidgetCmd procedure, "selection from" widget command} {
     list [catch {.e select from 2 3} msg] $msg
 } {1 {wrong # args: should be ".e selection from index"}}
-test entry-3.54 {EntryWidgetCmd procedure, "selection range" widget command} {
+test entry-3.60 {EntryWidgetCmd procedure, "selection range" widget command} {
     list [catch {.e select range 2} msg] $msg
 } {1 {wrong # args: should be ".e selection range start end"}}
-test entry-3.55 {EntryWidgetCmd procedure, "selection range" widget command} {
+test entry-3.61 {EntryWidgetCmd procedure, "selection range" widget command} {
     list [catch {.e selection range 2 3 4} msg] $msg
 } {1 {wrong # args: should be ".e selection range start end"}}
-test entry-3.56 {EntryWidgetCmd procedure, "selection range" widget command} {
+test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} {
     .e delete 0 end
     .e insert end 0123456789
     .e select from 1
@@ -374,7 +422,7 @@ test entry-3.56 {EntryWidgetCmd procedure, "selection range" widget command} {
     .e select range 4 4
     list [catch {.e index sel.first} msg] $msg
 } {1 {selection isn't in entry}}
-test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} {
+test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} {
     .e delete 0 end
     .e insert end 0123456789
     .e select from 3
@@ -385,78 +433,92 @@ test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} {
 .e delete 0 end
 .e insert end "This is quite a long text string, so long that it "
 .e insert end "runs off the end of the window quite a bit."
-test entry-3.58 {EntryWidgetCmd procedure, "selection to" widget command} {
+test entry-3.64 {EntryWidgetCmd procedure, "selection to" widget command} {
     list [catch {.e select to 2 3} msg] $msg
 } {1 {wrong # args: should be ".e selection to index"}}
-test entry-3.59 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview 5
     .e xview
 } {0.0537634 0.268817}
-test entry-3.60 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
     list [catch {.e xview gorp} msg] $msg
 } {1 {bad entry index "gorp"}}
-test entry-3.61 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview 0
     .e icursor 10
     .e xview insert
     .e xview
 } {0.107527 0.322581}
-test entry-3.62 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} {
     list [catch {.e xview moveto foo bar} msg] $msg
 } {1 {wrong # args: should be ".e xview moveto fraction"}}
-test entry-3.63 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} {
     list [catch {.e xview moveto foo} msg] $msg
 } {1 {expected floating-point number but got "foo"}}
-test entry-3.64 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview moveto 0.5
     .e xview
 } {0.505376 0.72043}
-test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} {
     list [catch {.e xview scroll 24} msg] $msg
 } {1 {wrong # args: should be ".e xview scroll number units|pages"}}
-test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} {
     list [catch {.e xview scroll gorp units} msg] $msg
 } {1 {expected integer but got "gorp"}}
-test entry-3.67 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview moveto 0
     .e xview scroll 1 pages
     .e xview
 } {0.193548 0.408602}
-test entry-3.68 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview moveto .9
     update
     .e xview scroll -2 p
     .e xview
 } {0.397849 0.612903}
-test entry-3.69 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.75 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview 30
     update
     .e xview scroll 2 units 
     .e index @0
 } {32}
-test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.76 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview 30
     update
     .e xview scroll -1 units 
     .e index @0
 } {29}
-test entry-3.71 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.77 {EntryWidgetCmd procedure, "xview" widget command} {
     list [catch {.e xview scroll 23 foobars} msg] $msg
 } {1 {bad argument "foobars": must be units or pages}}
-test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.78 {EntryWidgetCmd procedure, "xview" widget command} {
     list [catch {.e xview eat 23 hamburgers} msg] $msg
 } {1 {unknown option "eat": must be moveto or scroll}}
-test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview 0
     update
     .e xview -4
     .e index @0
 } {0}
-test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} {
     .e xview 300
     .e index @0
 } {73}
-test entry-3.75 {EntryWidgetCmd procedure} {
+.e insert 10 \u4e4e
+test entry-3.81 {EntryWidgetCmd procedure, "xview" widget command} {
+    # UTF
+    # If Tcl_NumUtfChars wasn't used, wrong answer would be:
+    # {0.106383 0.319149} {0.117021 0.351064} {0.117021 0.351064}
+
+    set x {}
+    .e xview moveto .1
+    lappend x [.e xview]
+    .e xview moveto .11
+    lappend x [.e xview]
+    .e xview moveto .12
+    lappend x [.e xview]
+} {{0.0957447 0.308511} {0.106383 0.319149} {0.117021 0.329787}}
+test entry-3.82 {EntryWidgetCmd procedure} {
     list [catch {.e gorp} msg] $msg
 } {1 {bad option "gorp": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
 
@@ -662,7 +724,7 @@ test entry-6.9 {EntryComputeGeometry procedure} {fonts} {
     update
     list [winfo reqwidth .e] [winfo reqheight .e]
 } {25 39}
-test entry-6.10 {EntryComputeGeometry procedure} {fonts} {
+test entry-6.10 {EntryComputeGeometry procedure} {unixOnly fonts} {
     catch {destroy .e}
     entry .e -bd 1 -relief raised -width 0 -show .
     .e insert 0 12345
@@ -674,6 +736,21 @@ test entry-6.10 {EntryComputeGeometry procedure} {fonts} {
     .e configure -show ""
     lappend x [winfo reqwidth .e]
 } {23 53 43}
+test entry-6.11 {EntryComputeGeometry procedure} {pcOnly} {
+    catch {destroy .e}
+    entry .e -bd 1 -relief raised -width 0 -show . -font {helvetica 12}
+    .e insert 0 12345
+    pack .e
+    update
+    set x [winfo reqwidth .e]
+    .e configure -show X
+    lappend x [winfo reqwidth .e]
+    .e configure -show ""
+    lappend x [winfo reqwidth .e]
+} [list \
+    [expr 8+5*[font measure {helvetica 12} .]] \
+    [expr 8+5*[font measure {helvetica 12} X]] \
+    [expr 8+[font measure {helvetica 12} 12345]]]
 
 catch {destroy .e}
 entry .e -width 10 -font $fixed -textvariable contents -xscrollcommand scroll
@@ -1089,52 +1166,62 @@ test entry-13.9 {GetEntryIndex procedure} {
     list [.e index sel.first] [.e index sel.last]
 } {1 6}
 selection clear .e
-test entry-13.10 {GetEntryIndex procedure} {pc} {
-    .e index sel.first
-} {1}
-test entry-13.11 {GetEntryIndex procedure} {!pc} {
+test entry-13.10 {GetEntryIndex procedure} {unixOnly} {
+    # On unix, when selection is cleared, entry widget's internal 
+    # selection range is reset.
+
     list [catch {.e index sel.first} msg] $msg
 } {1 {selection isn't in entry}}
-test entry-13.12 {GetEntryIndex procedure} {pc} {
-    list [catch {.e index sbogus} msg] $msg
-} {1 {bad entry index "sbogus"}}
-test entry-13.13 {GetEntryIndex procedure} {!pc} {
+test entry-13.11 {GetEntryIndex procedure} {macOrPc} {
+    # On mac and pc, when selection is cleared, entry widget remembers
+    # last selected range.  When selection ownership is restored to 
+    # entry, the old range will be rehighlighted.
+
+    list [catch {selection get}] [.e index sel.first]
+} {1 1}
+test entry-13.12 {GetEntryIndex procedure} {unixOnly} {
     list [catch {.e index sbogus} msg] $msg
 } {1 {selection isn't in entry}}
-test entry-13.14 {GetEntryIndex procedure} {
+test entry-13.13 {GetEntryIndex procedure} {macOrPc} {
+    list [catch {.e index sbogus} msg] $msg
+} {1 {bad entry index "sbogus"}}
+test entry-13.14 {GetEntryIndex procedure} {macOrPc} {
+    list [catch {selection get}] [catch {.e index sbogus}]
+} {1 1}
+test entry-13.15 {GetEntryIndex procedure} {
     list [catch {.e index @xyz} msg] $msg
 } {1 {bad entry index "@xyz"}}
-test entry-13.15 {GetEntryIndex procedure} {fonts} {
+test entry-13.16 {GetEntryIndex procedure} {fonts} {
     .e index @4
 } {4}
-test entry-13.16 {GetEntryIndex procedure} {fonts} {
+test entry-13.17 {GetEntryIndex procedure} {fonts} {
     .e index @11
 } {4}
-test entry-13.17 {GetEntryIndex procedure} {fonts} {
+test entry-13.18 {GetEntryIndex procedure} {fonts} {
     .e index @12
 } {5}
-test entry-13.18 {GetEntryIndex procedure} {fonts} {
+test entry-13.19 {GetEntryIndex procedure} {fonts} {
     .e index @[expr [winfo width .e] - 6]
 } {8}
-test entry-13.19 {GetEntryIndex procedure} {fonts} {
+test entry-13.20 {GetEntryIndex procedure} {fonts} {
     .e index @[expr [winfo width .e] - 5]
 } {9}
-test entry-13.20 {GetEntryIndex procedure} {
+test entry-13.21 {GetEntryIndex procedure} {
     .e index @1000
 } {9}
-test entry-13.21 {GetEntryIndex procedure} {
+test entry-13.22 {GetEntryIndex procedure} {
     list [catch {.e index 1xyz} msg] $msg
 } {1 {bad entry index "1xyz"}}
-test entry-13.22 {GetEntryIndex procedure} {
+test entry-13.23 {GetEntryIndex procedure} {
     .e index -10
 } {0}
-test entry-13.23 {GetEntryIndex procedure} {
+test entry-13.24 {GetEntryIndex procedure} {
     .e index 12
 } {12}
-test entry-13.24 {GetEntryIndex procedure} {
+test entry-13.25 {GetEntryIndex procedure} {
     .e index 49
 } {21}
-test entry-13.25 {GetEntryIndex procedure} {fonts} {
+test entry-13.26 {GetEntryIndex procedure} {fonts} {
     catch {destroy .e}
     entry .e -show .
     .e insert 0 XXXYZZY
@@ -1199,14 +1286,20 @@ test entry-16.1 {EntryVisibleRange procedure} {fonts} {
     .e insert 0 .............................
     .e xview
 } {0 0.827586}
-test entry-16.2 {EntryVisibleRange procedure} {fonts} {
+test entry-15.2 {EntryVisibleRange procedure} {unixOnly fonts} {
     .e configure -show X
     .e delete 0 end
     .e insert 0 .............................
     .e xview
 } {0 0.275862}
+test entry-15.3 {EntryVisibleRange procedure} {pcOnly} {
+    .e configure -show .
+    .e delete 0 end
+    .e insert 0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+    .e xview
+} {0 0.827586}
 .e configure -show ""
-test entry-16.3 {EntryVisibleRange procedure} {
+test entry-15.4 {EntryVisibleRange procedure} {
     .e delete 0 end
     .e xview
 } {0 1}
@@ -1265,5 +1358,21 @@ test entry-18.1 {Entry widget vs hiding} {
 # XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
 # and EntryTextVarProc.
 
-
 option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/event.test b/tests/event.test
index 0812f71..b5bfe6a 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -3,14 +3,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: event.test,v 1.2 1998/09/14 18:23:46 stanton Exp $
+# RCS: @(#) $Id: event.test,v 1.3 1999/04/16 01:51:37 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -39,3 +38,20 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} {
     destroy .b
     set x
 } {destroy}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/filebox.test b/tests/filebox.test
index 02e9295..e4bc512 100644
--- a/tests/filebox.test
+++ b/tests/filebox.test
@@ -3,15 +3,24 @@
 # for Tcl tests.
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: filebox.test,v 1.5 1998/12/07 23:29:00 hershey Exp $
+# RCS: @(#) $Id: filebox.test,v 1.6 1999/04/16 01:51:37 stanton Exp $
 #
 
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
 set tk_strictMotif_old $tk_strictMotif
 
+# Some tests require user interaction on non-unix platform
+
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+    [expr {$::tcltest::testConfig(userInteraction) || \
+	$::tcltest::testConfig(unixOnly)}]
+
 #----------------------------------------------------------------------
 #
 # Procedures needed by this test file
@@ -90,17 +99,18 @@ proc SendButtonPress {parent btn type} {
 #
 #----------------------------------------------------------------------
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
-}
-
 if {$tcl_platform(platform) == "unix"} {
     set modes "0 1"
 } else {
     set modes 1
 }
 
-set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent or -title}}
+set unknownOptionsMsg {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+
+set tmpFile "filebox.tmp"
+makeFile {
+    # this file can be empty!
+} $tmpFile
 
 foreach mode $modes {
 
@@ -118,11 +128,11 @@ foreach mode $modes {
     #
 
     foreach command "tk_getOpenFile tk_getSaveFile" {
-
 	test filebox-1.1 "$command command" {
 	    list [catch {$command -foo} msg] $msg
 	} $unknownOptionsMsg
 
+	catch {$command -foo 1} msg
 	regsub -all ,      $msg "" options
 	regsub \"-foo\" $options "" options
 
@@ -156,10 +166,6 @@ foreach mode $modes {
 	    set isNative 0
 	}
 
-	if {$isNative && ![info exists INTERACTIVE]} {
-	    continue
-	}
-
 	set parent .
 
 	set verylongstring longstring:
@@ -174,52 +180,48 @@ foreach mode $modes {
 #	set verylongstring $verylongstring$verylongstring
 
 	set color #404040
-	test filebox-2.1 "$command command" {
+	test filebox-2.1 "$command command" {nonUnixUserInteraction} {
 	    ToPressButton $parent cancel
 	    $command -title "Press Cancel ($verylongstring)" -parent $parent
 	} ""
 
-
 	if {$command == "tk_getSaveFile"} {
 	    set fileName "12x 455"
 	    set fileDir [pwd]
 	    set pathName [file join [pwd] $fileName]
 	} else {
-	    set thisFile [info script]
-	    set fileName [file tail $thisFile]
-
-	    # this file should be in the current working dir
+	    set fileName $tmpFile
 	    set fileDir [pwd]
 	    set pathName [file join $fileDir $fileName]
 	}
 
-	test filebox-2.2 "$command command" {
+	test filebox-2.2 "$command command" {nonUnixUserInteraction} {
 	    ToPressButton $parent ok
 	    set choice [$command -title "Press Ok" \
 			    -parent $parent -initialfile $fileName -initialdir $fileDir]
 	} $pathName
 
-	test filebox-2.3 "$command command" {
+	test filebox-2.3 "$command command" {nonUnixUserInteraction} {
 	    ToEnterFileByKey $parent $fileName $fileDir
 	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
 			    -parent $parent -initialdir $fileDir]
 	} $pathName
 
-	test filebox-2.4 "$command command" {
+	test filebox-2.4 "$command command" {nonUnixUserInteraction} {
 	    ToPressButton $parent ok
 	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
 			    -parent $parent -initialdir . \
 			    -initialfile $fileName]
 	} $pathName
 
-	test filebox-2.5 "$command command" {
+	test filebox-2.5 "$command command" {nonUnixUserInteraction} {
 	    ToPressButton $parent ok
 	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
 			    -parent $parent -initialdir /badpath \
 			    -initialfile $fileName]
 	} $pathName
 
-	test filebox-2.6 "$command command" {
+	test filebox-2.6 "$command command" {nonUnixUserInteraction} {
 	    toplevel .t1; toplevel .t2
 	    ToPressButton .t1 ok
 	    set choice {}
@@ -264,7 +266,7 @@ foreach mode $modes {
 	}
 
 	foreach x [lsort -integer [array names filters]] {
-	    test filebox-3.$x "$command command" {
+	    test filebox-3.$x "$command command" {nonUnixUserInteraction} {
 		ToPressButton $parent ok
 		set choice [$command -title "Press Ok" -filetypes $filters($x)\
 				-parent $parent -initialfile $fileName -initialdir $fileDir]
@@ -288,10 +290,19 @@ foreach mode $modes {
 
 set tk_strictMotif $tk_strictMotif_old
 
-if {$isNative && ![info exists INTERACTIVE]} {
-    puts " Some tests were skipped because they could not be performed"
-    puts " automatically on this platform. If you wish to execute them"
-    puts " interactively, set the TCL variable INTERACTIVE and re-run"
-    puts " the test."
-    return
-}
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/focus.test b/tests/focus.test
index a8c3f3b..e8f850a 100644
--- a/tests/focus.test
+++ b/tests/focus.test
@@ -3,18 +3,13 @@
 # standard fashion for Tcl tests.
 #
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: focus.test,v 1.4 1998/12/08 04:05:34 hershey Exp $
-
-if {$tcl_platform(platform) != "unix"} {
-    return
-}
+# RCS: @(#) $Id: focus.test,v 1.5 1999/04/16 01:51:37 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 eval destroy [winfo children .]
@@ -47,7 +42,7 @@ proc focusSetupAlt {} {
 }
 
 # Make sure the window manager knows who has focus
-fixfocus
+catch {fixfocus}
 
 # The following procedure ensures that there is no input focus
 # in this application.  It does it by arranging for another
@@ -65,8 +60,8 @@ proc focusClear {} {
 }
 
 focusSetup
-set altDisplay [info exists env(TK_ALT_DISPLAY)]
-if $altDisplay {
+set ::tcltest::testConfig(altDisplay) [info exists env(TK_ALT_DISPLAY)]
+if {$::tcltest::testConfig(altDisplay)} {
     focusSetupAlt
 }
 update
@@ -81,37 +76,35 @@ bind all <KeyPress> {
     append focusInfo "press %W %K"
 }
 
-test focus-1.1 {Tk_FocusCmd procedure} {
+test focus-1.1 {Tk_FocusCmd procedure} {unixOnly} {
     focusClear
     focus
 } {}
-if $altDisplay {
-    test focus-1.2 {Tk_FocusCmd procedure} {
-	focus .alt.b
-	focus
-    } {}
-}
-test focus-1.3 {Tk_FocusCmd procedure} {
+test focus-1.2 {Tk_FocusCmd procedure} {unixOnly altDisplay} {
+    focus .alt.b
+    focus
+} {}
+test focus-1.3 {Tk_FocusCmd procedure} {unixOnly} {
     focusClear
     focus .t.b3
     focus
 } {}
-test focus-1.4 {Tk_FocusCmd procedure} {
+test focus-1.4 {Tk_FocusCmd procedure} {unixOnly} {
     list [catch {focus ""} msg] $msg
 } {0 {}}
-test focus-1.5 {Tk_FocusCmd procedure} {
+test focus-1.5 {Tk_FocusCmd procedure} {unixOnly} {
     focusClear
     focus -force .t
     focus .t.b3
     focus
 } {.t.b3}
-test focus-1.6 {Tk_FocusCmd procedure} {
+test focus-1.6 {Tk_FocusCmd procedure} {unixOnly} {
     list [catch {focus .gorp} msg] $msg
 } {1 {bad window path name ".gorp"}}
-test focus-1.7 {Tk_FocusCmd procedure} {
+test focus-1.7 {Tk_FocusCmd procedure} {unixOnly} {
     list [catch {focus .gorp a} msg] $msg
 } {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}}
-test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {
+test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {unixOnly} {
     toplevel .t2
     wm geom .t2 +10+10
     frame .t2.f -width 200 -height 100 -bd 2 -relief raised
@@ -130,91 +123,88 @@ test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {
     destroy .t2
     set x
 } {.t2.f2 .t2 .t2}
-test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {
+test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
     list [catch {focus -displayof} msg] $msg
 } {1 {wrong # args: should be "focus -displayof window"}}
-test focus-1.10 {Tk_FocusCmd procedure, -displayof option} {
+test focus-1.10 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
     list [catch {focus -displayof a b} msg] $msg
 } {1 {wrong # args: should be "focus -displayof window"}}
-test focus-1.11 {Tk_FocusCmd procedure, -displayof option} {
+test focus-1.11 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
     list [catch {focus -displayof .lousy} msg] $msg
 } {1 {bad window path name ".lousy"}}
-test focus-1.12 {Tk_FocusCmd procedure, -displayof option} {
+test focus-1.12 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
     focusClear
     focus .t
     focus -displayof .t.b3
 } {}
-test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {
+test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
     focusClear
     focus -force .t
     focus -displayof .t.b3
 } {.t}
-if $altDisplay {
-    test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {
-	focus -force .alt.c
-	focus -displayof .alt
-    } {.alt.c}
-}
-test focus-1.15 {Tk_FocusCmd procedure, -force option} {
+test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unixOnly altDisplay} {
+    focus -force .alt.c
+    focus -displayof .alt
+} {.alt.c}
+test focus-1.15 {Tk_FocusCmd procedure, -force option} {unixOnly} {
     list [catch {focus -force} msg] $msg
 } {1 {wrong # args: should be "focus -force window"}}
-test focus-1.16 {Tk_FocusCmd procedure, -force option} {
+test focus-1.16 {Tk_FocusCmd procedure, -force option} {unixOnly} {
     list [catch {focus -force a b} msg] $msg
 } {1 {wrong # args: should be "focus -force window"}}
-test focus-1.17 {Tk_FocusCmd procedure, -force option} {
+test focus-1.17 {Tk_FocusCmd procedure, -force option} {unixOnly} {
     list [catch {focus -force foo} msg] $msg
 } {1 {bad window path name "foo"}}
-test focus-1.18 {Tk_FocusCmd procedure, -force option} {
+test focus-1.18 {Tk_FocusCmd procedure, -force option} {unixOnly} {
     list [catch {focus -force ""} msg] $msg
 } {0 {}}
-test focus-1.19 {Tk_FocusCmd procedure, -force option} {
+test focus-1.19 {Tk_FocusCmd procedure, -force option} {unixOnly} {
     focusClear
     focus .t.b1
     set x  [list [focus]]
     focus -force .t.b1
     lappend x [focus]
 } {{} .t.b1}
-test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} {
+test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
     list [catch {focus -lastfor} msg] $msg
 } {1 {wrong # args: should be "focus -lastfor window"}}
-test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} {
+test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
     list [catch {focus -lastfor 1 2} msg] $msg
 } {1 {wrong # args: should be "focus -lastfor window"}}
-test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} {
+test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
     list [catch {focus -lastfor who_knows?} msg] $msg
 } {1 {bad window path name "who_knows?"}}
-test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} {
+test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
     focus .b
     focus .t.b1
     list [focus -lastfor .] [focus -lastfor .t.b3]
 } {.b .t.b1}
-test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} {
+test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} {unixOnly} {
     destroy .t
     focusSetup
     update
     focus -lastfor .t.b2
 } {.t}
-test focus-1.25 {Tk_FocusCmd procedure} {
+test focus-1.25 {Tk_FocusCmd procedure} {unixOnly} {
     list [catch {focus -unknown} msg] $msg
 } {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}}
 
-if {[string compare testwrapper [info commands testwrapper]] != 0} {
-    puts "This application hasn't been compiled with the testwrapper command,"
-    puts "therefore I am skipping all of these tests."
-    cleanupbg
-    return
-}
+# Some tests require the testwrapper command
 
-test focus-2.1 {TkFocusFilterEvent procedure} {nonPortable} {
+set ::tcltest::testConfig(testwrapper) \
+	[expr {[info commands testwrapper] != {}}]
+
+test focus-2.1 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
     focus -force .b
     destroy .t
     focusSetup
     update
     set focusInfo {}
-    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor -sendevent 0x54217567
+    event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \
+	    -sendevent 0x54217567
     list $focusInfo
 } {{}}
-test focus-2.2 {TkFocusFilterEvent procedure} {nonPortable} {
+test focus-2.2 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
     focus -force .b
     destroy .t
     focusSetup
@@ -224,7 +214,7 @@ test focus-2.2 {TkFocusFilterEvent procedure} {nonPortable} {
     list $focusInfo [focus]
 } {{in .t NotifyAncestor
 } .b}
-test focus-2.3 {TkFocusFilterEvent procedure} {nonPortable} {
+test focus-2.3 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
     focus -force .b
     destroy .t
     focusSetup
@@ -237,7 +227,8 @@ test focus-2.3 {TkFocusFilterEvent procedure} {nonPortable} {
 out . NotifyNonlinearVirtual
 in .t NotifyNonlinear
 } .t}
-test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} {nonPortable} {
+test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \
+	{unixOnly nonPortable testwrapper} {
     set result {}
     focus .t.b1
     # Important to end with NotifyAncestor, which is an
@@ -267,7 +258,8 @@ in .t.b1 NotifyNonlinear
 in .t NotifyNonlinearVirtual
 in .t.b1 NotifyNonlinear
 }}
-test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} {nonPortable} {
+test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \
+	{unixOnly nonPortable testwrapper} {
     focusSetup
     focus .t.b1
     update
@@ -277,7 +269,8 @@ test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} {nonPor
 in .t NotifyNonlinearVirtual
 in .t.b1 NotifyNonlinear
 } .t.b1}
-test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} {
+test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \
+	{unixOnly testwrapper} {
     focus .t.b1
     focus .
     update
@@ -287,7 +280,8 @@ test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} {
     event gen . <KeyPress-x>
     list $x $focusInfo
 } {.t.b1 {press .t.b1 x}}
-test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} {
+test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \
+	{unixOnly testwrapper} {
     set result {}
     foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
 	    NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot
@@ -299,17 +293,20 @@ test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} {
     }
     set result
 } {{} .t.b1 {} {} .t.b1 .t.b1 {}}
-test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} {
+test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \
+	{unixOnly testwrapper} {
     focus -force .t.b1
     event gen .t.b1 <FocusOut> -detail NotifyAncestor
     focus
 } {.t.b1}
-test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} {
+test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \
+	{unixOnly testwrapper} {
     focus .t.b1
     event gen [testwrapper .] <FocusOut> -detail NotifyAncestor
     focus
 } {}
-test focus-2.10 {TkFocusFilterEvent procedure, Enter events} {
+test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \
+	{unixOnly testwrapper} {
     set result {}
     focus .t.b1
     focusClear
@@ -323,14 +320,16 @@ test focus-2.10 {TkFocusFilterEvent procedure, Enter events} {
     }
     set result
 } {.t.b1 {} .t.b1 .t.b1 .t.b1}
-test focus-2.11 {TkFocusFilterEvent procedure, Enter events} {
+test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \
+	{unixOnly testwrapper} {
     focusClear
     set focusInfo {}
     event gen [testwrapper .t] <Enter> -detail NotifyAncestor
     update
     set focusInfo
 } {}
-test focus-2.12 {TkFocusFilterEvent procedure, Enter events} {
+test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \
+	{unixOnly testwrapper} {
     focus -force .b
     update
     set focusInfo {}
@@ -338,7 +337,8 @@ test focus-2.12 {TkFocusFilterEvent procedure, Enter events} {
     update
     set focusInfo
 } {}
-test focus-2.13 {TkFocusFilterEvent procedure, Enter events} {
+test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \
+	{unixOnly testwrapper} {
     focus .t.b1
     focusClear
     event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
@@ -348,7 +348,7 @@ test focus-2.13 {TkFocusFilterEvent procedure, Enter events} {
 } {in .t NotifyVirtual
 in .t.b1 NotifyAncestor
 }
-test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {
+test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unixOnly testwrapper} {
     focusClear
     catch {destroy .t2}
     toplevel .t2
@@ -359,7 +359,8 @@ test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when
     update
     destroy .t2
 } {}
-test focus-2.15 {TkFocusFilterEvent procedure, Leave events} {
+test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \
+	{unixOnly testwrapper} {
     set result {}
     focus .t.b1
     foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
@@ -373,7 +374,8 @@ test focus-2.15 {TkFocusFilterEvent procedure, Leave events} {
     }
     set result
 } {{} .t.b1 {} {} {}}
-test focus-2.16 {TkFocusFilterEvent procedure, Leave events} {
+test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \
+	{unixOnly testwrapper} {
     set result {}
     focus .t.b1
     event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
@@ -385,7 +387,8 @@ test focus-2.16 {TkFocusFilterEvent procedure, Leave events} {
 } {out .t.b1 NotifyAncestor
 out .t NotifyVirtual
 }
-test focus-2.17 {TkFocusFilterEvent procedure, Leave events} {
+test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \
+	{unixOnly testwrapper} {
     set result {}
     focus .t.b1
     event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
@@ -399,7 +402,8 @@ test focus-2.17 {TkFocusFilterEvent procedure, Leave events} {
 out .t NotifyVirtual
 } {}}
 
-test focus-3.1 {SetFocus procedure, create record on focus} {
+test focus-3.1 {SetFocus procedure, create record on focus} \
+	{unixOnly testwrapper} {
     toplevel .t2 -width 250 -height 100
     wm geometry .t2 +0+0
     update
@@ -411,7 +415,8 @@ catch {destroy .t2}
 # This test produces no result, but it will generate a protocol
 # error if Tk forgets to make the window exist before focussing
 # on it.
-test focus-3.2 {SetFocus procedure, making window exist} {
+test focus-3.2 {SetFocus procedure, making window exist} \
+	{unixOnly testwrapper} {
     update
     button .b2 -text "Another button"
     focus .b2
@@ -421,12 +426,14 @@ catch {destroy .b2}
 update
 # The following test doesn't produce a check-able result, but if
 # there are bugs it may generate an X protocol error.
-test focus-3.3 {SetFocus procedure, delaying claim of X focus} {
+test focus-3.3 {SetFocus procedure, delaying claim of X focus} \
+	{unixOnly testwrapper} {
     focusSetup
     focus -force .t.b2
     update
 } {}
-test focus-3.4 {SetFocus procedure, delaying claim of X focus} {
+test focus-3.4 {SetFocus procedure, delaying claim of X focus} \
+	{unixOnly testwrapper} {
     focusSetup
     wm withdraw .t
     focus -force .t.b2
@@ -439,7 +446,8 @@ test focus-3.4 {SetFocus procedure, delaying claim of X focus} {
     wm deiconify .t
 } {}
 catch {destroy .t2}
-test focus-3.5 {SetFocus procedure, generating events} {
+test focus-3.5 {SetFocus procedure, generating events} \
+	{unixOnly testwrapper} {
     focusSetup
     focusClear
     set focusInfo {}
@@ -449,7 +457,8 @@ test focus-3.5 {SetFocus procedure, generating events} {
 } {in .t NotifyVirtual
 in .t.b2 NotifyAncestor
 }
-test focus-3.6 {SetFocus procedure, generating events} {
+test focus-3.6 {SetFocus procedure, generating events} \
+	{unixOnly testwrapper} {
     focusSetup
     focus -force .b
     update
@@ -462,7 +471,8 @@ out . NotifyNonlinearVirtual
 in .t NotifyNonlinearVirtual
 in .t.b2 NotifyNonlinear
 }
-test focus-3.7 {SetFocus procedure, generating events} {nonPortable} {
+test focus-3.7 {SetFocus procedure, generating events} \
+	{unixOnly nonPortable testwrapper} {
     # Non-portable because some platforms generate extra events.
 
     focusSetup
@@ -473,7 +483,7 @@ test focus-3.7 {SetFocus procedure, generating events} {nonPortable} {
     set focusInfo
 } {}
 
-test focus-4.1 {TkFocusDeadWindow procedure} {
+test focus-4.1 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
     focusSetup
     update
     focus -force .b
@@ -481,7 +491,7 @@ test focus-4.1 {TkFocusDeadWindow procedure} {
     destroy .t
     focus
 } {.b}
-test focus-4.2 {TkFocusDeadWindow procedure} {
+test focus-4.2 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
     focusSetup
     update
     focus -force .t.b2
@@ -495,7 +505,7 @@ test focus-4.2 {TkFocusDeadWindow procedure} {
 # Non-portable due to wm-specific redirection of input focus when
 # windows are deleted:
 
-test focus-4.3 {TkFocusDeadWindow procedure} {nonPortable} {
+test focus-4.3 {TkFocusDeadWindow procedure} {unixOnly nonPortable testwrapper} {
     focusSetup
     update
     focus .t
@@ -504,7 +514,7 @@ test focus-4.3 {TkFocusDeadWindow procedure} {nonPortable} {
     update
     focus
 } {}
-test focus-4.4 {TkFocusDeadWindow procedure} {
+test focus-4.4 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
     focusSetup
     focus -force .t.b2
     update
@@ -515,7 +525,21 @@ test focus-4.4 {TkFocusDeadWindow procedure} {
 # I don't know how to test most of the remaining procedures of this file
 # explicitly;  they've already been exercised by the preceding tests.
 
-test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} {
+# If send is disabled because of inadequate security, don't run any
+# of these tests at all.
+
+setupbg
+set app [dobg {tk appname}]
+set ::tcltest::testConfig(secureServer) 1
+if {[catch {send $app set a 0} msg] == 1} {
+    if [string match "X server insecure *" $msg] {
+	set ::tcltest::testConfig(secureServer) 0
+    }
+}
+cleanupbg
+setupbg
+test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \
+	{unixOnly testwrapper secureServer} {
     focusSetup
     focus -force .t
     update
@@ -525,7 +549,7 @@ test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} {
     focus .t.b2
     update
     lappend result [focus]
-} {.t .t {}}
+} {.t {} {}}
 
 catch {destroy .t}
 bind all <FocusIn> {}
@@ -534,7 +558,8 @@ bind all <KeyPress> {}
 cleanupbg
 fixfocus
 
-test focus-6.1 {miscellaneous - embedded application in same process} {unixOnly} {
+test focus-6.1 {miscellaneous - embedded application in same process} \
+	{unixOnly testwrapper} {
     eval interp delete [interp slaves]
     catch {destroy .t}
     toplevel .t
@@ -583,7 +608,8 @@ test focus-6.1 {miscellaneous - embedded application in same process} {unixOnly}
     interp delete child
     set result
 } {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}}
-test focus-6.2 {miscellaneous - embedded application in different process} {unixOnly} {
+test focus-6.2 {miscellaneous - embedded application in different process} \
+	{unixOnly testwrapper} {
     eval interp delete [interp slaves]
     catch {destroy .t}
     setupbg
@@ -635,3 +661,20 @@ test focus-6.2 {miscellaneous - embedded application in different process} {unix
 eval destroy [winfo children .]
 bind all <FocusIn> {}
 bind all <FocusOut> {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/focusTcl.test b/tests/focusTcl.test
index 14c1d3d..0d223cf 100644
--- a/tests/focusTcl.test
+++ b/tests/focusTcl.test
@@ -4,14 +4,13 @@
 # standard fashion for Tcl tests.
 #
 # Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: focusTcl.test,v 1.2 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: focusTcl.test,v 1.3 1999/04/16 01:51:37 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 eval destroy [winfo children .]
@@ -277,3 +276,20 @@ test focusTcl-5.11 {tkFocusOK procedure, -takefocus "", check for bindings} {
 bind Frame <Key> {}
 . configure -takefocus 0 -highlightthickness 0
 option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/font.test b/tests/font.test
index 909085b..264dee5 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -1,16 +1,21 @@
 # This file is a Tcl script to test out Tk's "font" command
 # plus the procedures in tkFont.c.  It is organized in the
-# standard fashion for Tcl tests.
+# standard white-box fashion for Tcl tests.
 #
-# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1996-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: font.test,v 1.3 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: font.test,v 1.4 1999/04/16 01:51:37 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
-if {[string compare test [info procs test]] != 0} {
-    source defs
+if {[info commands testfont] != "testfont"} {
+    puts "testfont command not available; skipping tests"
+    ::tcltest::cleanupTests
+    return
 }
 
 catch {destroy .b}
@@ -20,7 +25,7 @@ update idletasks
 
 proc setup {} {
     catch {destroy .b.f}
-    catch {font delete xyz}
+    catch {eval font delete [font names]}
     label .b.f 
     pack .b.f
     update
@@ -56,243 +61,357 @@ case $tcl_platform(platform) {
 }
 set times [font actual {times 0} -family]
 
-test font-1.1 {font command: general} {
+test font-1.1 {TkFontPkgInit} {
+    catch {interp delete foo}
+    interp create foo
+    foo eval {
+	load {} Tk
+	wm geometry . +0+0
+	update
+    }
+    interp delete foo
+} {}
+
+test font-2.1 {TkFontPkgFree} {
+    catch {interp delete foo}
+    interp create foo
+    set x {}
+
+    # Makes sure that named font was visible only to child interp.
+
+    foo eval {
+	load {} Tk
+	wm geometry . +0+0
+	button .b -font {times 16} -text "hi"
+	pack .b
+	font create wiggles -family courier -underline 1
+	update
+    }
+    lappend x [catch {font configure wiggles} msg; set msg]
+
+    # Tests cancelling the idle handler for TheWorldHasChanged,
+    # because app goes away before idle serviced.
+    
+    foo eval {
+	.b config -font wiggles
+	font config wiggles -size 24
+	destroy .
+    }
+    lappend x [foo eval {catch {font families} msg; set msg}]
+
+    interp delete foo
+    set x
+} {{named font "wiggles" doesn't exist} {can't invoke "font" command:  application has been destroyed}}
+
+
+test font-3.1 {font command: general} {
     list [catch {font} msg] $msg
 } {1 {wrong # args: should be "font option ?arg?"}}
-test font-1.2 {font command: actual: arguments} {
+test font-3.2 {font command: general} {
+    list [catch {font xyz} msg] $msg
+} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}
+
+test font-4.1 {font command: actual: arguments} {
+    # (skip < 0)
     list [catch {font actual xyz -displayof} msg] $msg
 } {1 {value for "-displayof" missing}}
-test font-1.3 {font command: actual: arguments} {
+test font-4.2 {font command: actual: arguments} {
+    # (objc < 3) 
     list [catch {font actual} msg] $msg
 } {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
-test font-1.4 {font command: actual: arguments} {
+test font-4.3 {font command: actual: arguments} {
+    # (objc - skip > 4) when skip == 0
     list [catch {font actual xyz abc def} msg] $msg
 } {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
-test font-1.5 {font command: actual: arguments} {
-    list [catch {font actual {}} msg] $msg
-} {1 {font "" doesn't exist}}
-test font-1.6 {font command: actual: displayof specified, so skip to next} {
+test font-4.4 {font command: actual: displayof specified, so skip to next} {
     catch {font actual xyz -displayof . -size}
 } {0}
-test font-1.7 {font command: actual: displayof specified, so skip to next} {
+test font-4.5 {font command: actual: displayof specified, so skip to next} {
     lindex [font actual xyz -displayof .] 0
 } {-family}
-test font-1.8 {font command: actual} {unix || mac} {
+test font-4.6 {font command: actual: arguments} {
+    # (objc - skip > 4) when skip == 2
+    list [catch {font actual xyz -displayof . abc def} msg] $msg
+} {1 {wrong # args: should be "font actual font ?-displayof window? ?option?"}}
+test font-4.7 {font command: actual: arguments} {
+    # (tkfont == NULL)
+    list [catch {font actual "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-4.8 {font command: actual: all attributes} {
+    # not (objc > 3) so objPtr = NULL
+    lindex [font actual {-family times}] 0
+} {-family}
+test font-4.9 {font command: actual} {macOrUnix} {
+    # (objc > 3) so objPtr = objv[3 + skip]
     string tolower [font actual {-family times} -family]
 } {times}
-test font-1.9 {font command: actual} {pcOnly} {
+test font-4.10 {font command: actual} {pcOnly} {
+    # (objc > 3) so objPtr = objv[3 + skip]
     font actual {-family times} -family
 } {Times New Roman}
-test font-1.10 {font command: actual} {
-    lindex [font actual {-family times}] 0
-} {-family}
-test font-1.11 {font command: bad option} {
+test font-4.11 {font command: bad option} {
     list [catch {font actual xyz -style} msg] $msg
 } {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
 
-test font-2.1 {font command: configure} {
+test font-5.1 {font command: configure} {
+    # (objc < 3) 
     list [catch {font configure} msg] $msg
 } {1 {wrong # args: should be "font configure fontname ?options?"}}
-test font-2.2 {font command: configure: non-existent font} {
+test font-5.2 {font command: configure: non-existent font} {
+    # (namedHashPtr == NULL)
     list [catch {font configure xyz} msg] $msg
 } {1 {named font "xyz" doesn't exist}}
-test font-2.3 {font command: configure: "deleted" font} {
+test font-5.3 {font command: configure: "deleted" font} {
+    # (nfPtr->deletePending != 0) 
     setup
     font create xyz
     .b.f configure -font xyz
     font delete xyz
     list [catch {font configure xyz} msg] $msg
 } {1 {named font "xyz" doesn't exist}}
-test font-2.4 {font command: configure: get all options} {
+test font-5.4 {font command: configure: get all options} {
+    # (objc == 3) so objPtr = NULL
     setup
     font create xyz -family xyz
     lindex [font configure xyz] 1
 } xyz
-test font-2.5 {font command: configure: get one option} {
+test font-5.5 {font command: configure: get one option} {
+    # (objc == 4) so objPtr = objv[3]
     setup
     font create xyz -family xyz
     font configure xyz -family
 } xyz
-test font-2.6 {font command: configure: update existing font} {
+test font-5.6 {font command: configure: update existing font} {
+    # else result = ConfigAttributesObj()
     setup
     font create xyz
     font configure xyz -family xyz
     update
     font configure xyz -family
 } xyz
-test font-2.7 {font command: configure: bad option} {
+test font-5.7 {font command: configure: bad option} {
     setup
     font create xyz
     list [catch {font configure xyz -style} msg] $msg
 } {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
 
-test font-3.1 {font command: create: make up name} {
-    font delete [font create]
-    font delete [font create -family xyz]
-} {}
-test font-3.2 {font command: create: already exists} {
+test font-6.1 {font command: create: make up name} {
+    # (objc < 3) so name = NULL
     setup
-    font create xyz
-    list [catch {font create xyz} msg] $msg
-} {1 {font "xyz" already exists}}
-test font-3.3 {font command: create: error recreating "deleted" font} {
+    font create
+    font names
+} {font1}
+test font-6.2 {font command: create: name specified} {
+    # not (objc < 3)
     setup
     font create xyz
-    .b.f configure -font xyz
-    font delete xyz
-    list [catch {font create xyz -xyz times} msg] $msg
-} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-3.4 {font command: create: recreate "deleted" font} {
+    font names
+} {xyz}
+test font-6.3 {font command: create: name not really specified} {
+    # (name[0] == '-') so name = NULL
     setup
-    font create xyz
-    .b.f configure -font xyz
-    font delete xyz
-    font actual xyz
-    font create xyz -family times
-    update
-    font configure xyz -family
-} {times}
-test font-3.5 {font command: create: bad option creating new font} {
+    font create -family xyz
+    font names
+} {font1}
+test font-6.4 {font command: create: generate name} {
+    # (name == NULL)
+    setup
+    font create -family one
+    font create -family two
+    font create -family three
+    font delete font2
+    font create -family four
+    font configure font2 -family
+} {four}
+test font-6.5 {font command: create: bad option creating new font} {
+    # name was specified so skip = 3 
     setup
     list [catch {font create xyz -xyz times} msg] $msg
 } {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-3.6 {font command: create: totally new font} {
+test font-6.6 {font command: create: bad option creating new font} {
+    # name was not specified so skip = 2 
     setup
-    font create xyz -family xyz
-    font configure xyz -family
-} {xyz}
+    list [catch {font create -xyz times} msg] $msg
+} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+test font-6.7 {font command: create: already exists} {
+    # (CreateNamedFont() != TCL_OK)
+    setup
+    font create xyz
+    list [catch {font create xyz} msg] $msg
+} {1 {named font "xyz" already exists}}
 
-test font-4.1 {font command: delete: arguments} {
+test font-7.1 {font command: delete: arguments} {
+    # (objc < 3) 
     list [catch {font delete} msg] $msg
 } {1 {wrong # args: should be "font delete fontname ?fontname ...?"}}
-test font-4.2 {font command: delete: loop test} {
+test font-7.2 {font command: delete: loop test} {
+    # for (i = 2; i < objc; i++) 
+    setup
+    set x {}
     font create a -underline 1
     font create b -underline 1
     font create c -underline 1
-    font delete a b c
-    list [font actual a -underline] [font actual b -underline] [font actual c -underline]
-} {0 0 0}
-test font-4.3 {font command: delete: non-existent} {
+    font create d -underline 1
+    font create e -underline 1
+    lappend x [lsort [font names]]
+    font delete a e c b
+    lappend x [lsort [font names]]
+} {{a b c d e} d}
+test font-7.3 {font command: delete: loop test} {
+    # (namedHashPtr == NULL) in middle of loop
+    setup
+    set x {}
+    font create a -underline 1
+    font create b -underline 1
+    font create c -underline 1
+    font create d -underline 1
+    font create e -underline 1
+    lappend x [lsort [font names]]
+    catch {font delete a d q c e b}
+    lappend x [lsort [font names]]
+} {{a b c d e} {b c e}}
+test font-7.4 {font command: delete: non-existent} {
+    # (namedHashPtr == NULL) 
     setup
     list [catch {font delete xyz} msg] $msg
 } {1 {named font "xyz" doesn't exist}}
-test font-4.4 {font command: delete: mark for later deletion} {
+test font-7.5 {font command: delete: mark for later deletion} {
+    # (nfPtr->refCount != 0)
     setup
     font create xyz
     .b.f configure -font xyz
     font delete xyz
     font actual xyz
-    list [catch {font configure xyz} msg] $msg
-} {1 {named font "xyz" doesn't exist}}
-test font-4.5 {font command: delete: actually delete} {
+    list [catch {font configure xyz} msg] $msg [.b.f cget -font]
+} {1 {named font "xyz" doesn't exist} xyz}
+test font-7.6 {font command: delete: actually delete} {
+    # not (nfPtr->refCount != 0)
     setup
     font create xyz -underline 1
     font delete xyz
-    font actual xyz -underline
-} {0}
+    catch {font config xyz}
+} {1}
+setup
 
-test font-5.1 {font command: families: arguments} {
+test font-8.1 {font command: families: arguments} {
+    # (skip < 0)
     list [catch {font families -displayof} msg] $msg
 } {1 {value for "-displayof" missing}}
-test font-5.2 {font command: families: arguments} {
+test font-8.2 {font command: families: arguments} {
+    # (objc - skip != 2) when skip == 0
     list [catch {font families xyz} msg] $msg
 } {1 {wrong # args: should be "font families ?-displayof window?"}}
-test font-5.3 {font command: families} {
-    font families
-    set x {}
-} {}
+test font-8.3 {font command: families: arguments} {
+    # (objc - skip != 2) when skip == 2
+    list [catch {font families -displayof . xyz} msg] $msg
+} {1 {wrong # args: should be "font families ?-displayof window?"}}
+test font-8.4 {font command: families} {
+    # TkpGetFontFamilies()
+    regexp -nocase times [font families]
+} {1}
 
-test font-6.1 {font command: measure: arguments} {
+test font-9.1 {font command: measure: arguments} {
+    # (skip < 0)
     list [catch {font measure xyz -displayof} msg] $msg
 } {1 {value for "-displayof" missing}}
-test font-6.2 {font command: measure: arguments} {
+test font-9.2 {font command: measure: arguments} {
+    # (objc - skip != 4) 
     list [catch {font measure} msg] $msg
 } {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
-test font-6.3 {font command: measure: arguments} {
+test font-9.3 {font command: measure: arguments} {
+    # (objc - skip != 4) 
     list [catch {font measure xyz abc def} msg] $msg
 } {1 {wrong # args: should be "font measure font ?-displayof window? text"}}
-test font-6.4 {font command: measure: arguments} {
-    list [catch {font measure {} abc} msg] $msg
-} {1 {font "" doesn't exist}}
-test font-6.5 {font command: measure} {
+test font-9.4 {font command: measure: arguments} {
+    # (tkfont == NULL)
+    list [catch {font measure "\{xyz" abc} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-9.5 {font command: measure} {
+    # Tk_TextWidth()
     expr [font measure $fixed "abcdefg"]==[font measure $fixed "a"]*7
 } {1}
 
-test font-7.1 {font command: metrics: arguments} {
+test font-10.1 {font command: metrics: arguments} {
+    list [catch {font metrics xyz -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test font-10.2 {font command: metrics: arguments} {
+    # (skip < 0)
     list [catch {font metrics xyz -displayof} msg] $msg
 } {1 {value for "-displayof" missing}}
-test font-7.2 {font command: metrics: arguments} {
+test font-10.3 {font command: metrics: arguments} {
+    # (objc < 3) 
     list [catch {font metrics} msg] $msg
 } {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
-test font-7.3 {font command: metrics: get all metrics} {
+test font-10.4 {font command: metrics: arguments} {
+    # (objc - skip) > 4) when skip == 0
+    list [catch {font metrics xyz abc def} msg] $msg
+} {1 {wrong # args: should be "font metrics font ?-displayof window? ?option?"}}
+test font-10.5 {font command: metrics: arguments} {
+    # (objc - skip) > 4) when skip == 2
+    list [catch {font metrics xyz -displayof . abc} msg] $msg
+} {1 {bad metric "abc": must be -ascent, -descent, -linespace, or -fixed}}
+test font-10.6 {font command: metrics: bad font} {
+    # (tkfont == NULL)
+    list [catch {font metrics "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-10.7 {font command: metrics: get all metrics} {
+    # (objc == 3)
     catch {unset a}
     array set a [font metrics {-family xyz}]
     set x [lsort [array names a]]
     unset a
     set x    
 } {-ascent -descent -fixed -linespace}
-test font-7.4 {font command: metrics: get ascent} {
-    catch {expr [font metrics $fixed -ascent]}
-} {0}
-test font-7.5 {font command: metrics: get descent} {
-    catch {expr [font metrics {-family xyz} -descent]}
-} {0}
-test font-7.6 {font command: metrics: get linespace} {
-    catch {expr [font metrics {-family fixed} -linespace]}
-} {0}
-test font-7.7 {font command: metrics: get fixed} {
-    catch {expr [font metrics {-family fixed} -fixed]}
-} {0}
-test font-7.8 {font command: metrics: get ascent} {
-    catch {expr [font metrics {-family xyz} -ascent]}
-} {0}
-test font-7.9 {font command: metrics: get descent} {
-    catch {expr [font metrics {-family xyz} -descent]}
-} {0}
-test font-7.10 {font command: metrics: get linespace} {
-    catch {expr [font metrics {-family fixed} -linespace]}
-} {0}
-test font-7.11 {font command: metrics: get fixed} {
-    catch {expr [font metrics {-family fixed} -fixed]}
-} {0}
-test font-7.12 {font command: metrics: bad metric} {
-    list [catch {font metrics {-family fixed} -xyz} msg] $msg
+test font-10.8 {font command: metrics: bad metric} {
+    # (Tcl_GetIndexFromObj() != TCL_OK)
+    list [catch {font metrics $fixed -xyz} msg] $msg
 } {1 {bad metric "-xyz": must be -ascent, -descent, -linespace, or -fixed}}
+test font-10.9 {font command: metrics: get individual metrics} {
+    font metrics $fixed -ascent
+    font metrics $fixed -descent
+    font metrics $fixed -linespace
+    font metrics $fixed -fixed
+} {1}
 
-test font-8.1 {font command: names: arguments} {
+test font-11.1 {font command: names: arguments} {
+    # (objc != 2)
     list [catch {font names xyz} msg] $msg
 } {1 {wrong # args: should be "font names"}}
-test font-8.2 {font command: names} {
+test font-11.2 {font command: names: loop test: no passes} {
+    setup
+    font names
+} {}
+test font-11.3 {font command: names: loop test: one pass} {
+    setup
+    font create
+    font names
+} {font1}
+test font-11.4 {font command: names: loop test: multiple passes} {
     setup
     font create xyz
     font create abc
-    set x [lsort [font names]]
-    font delete abc
-    font delete xyz
-    set x
-} {abc xyz}
-test font-8.3 {font command: names} {
+    font create def
+    lsort [font names]
+} {abc def xyz}
+test font-11.5 {font command: names: skip deletePending fonts} {
+    # (nfPtr->deletePending == 0)
     setup
+    set x {}
     font create xyz
     font create abc
-    set x [lsort [font names]]
+    lappend x [lsort [font names]]
     .b.f config -font xyz
     font delete xyz
     lappend x [font names]
-    font delete abc
-    set x
-} {abc xyz abc}
+} {{abc xyz} abc}
 
-test font-9.1 {font command: unknown option} {
-    list [catch {font xyz} msg] $msg
-} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}
-
-test font-10.1 {UpdateDependantFonts procedure: no users} {
+test font-12.1 {UpdateDependantFonts procedure: no users} {
+    # (nfPtr->refCount == 0)
     setup
     font create xyz
     font configure xyz -family times
 } {}
-test font-10.2 {UpdateDependantFonts procedure: pings the widgets} {
+test font-12.2 {UpdateDependantFonts procedure: pings the widgets} {
     setup
     font create xyz -family times -size 20
     .b.f config -font xyz -text "abcd" -padx 0 -bd 0 -highlightthickness 0
@@ -306,56 +425,155 @@ test font-10.2 {UpdateDependantFonts procedure: pings the widgets} {
     expr {$a1==$b1 && $a2==$b2}
 } {1}
 
-test font-11.1 {Tk_GetFont procedure: bump ref count} {
+test font-13.1 {CreateNamedFont: new named font} {
+    # not (new == 0)
+    setup
+    set x {}
+    lappend x [font names]
+    font create xyz
+    lappend x [font names]
+} {{} xyz}
+test font-13.2 {CreateNamedFont: named font already exists} {
+    # (new == 0)
+    setup
+    font create xyz
+    list [catch {font create xyz} msg] $msg
+} {1 {named font "xyz" already exists}}
+test font-13.3 {CreateNamedFont: named font already exists} {
+    # (nfPtr->deletePending == 0)
+    setup
+    font create xyz
+    list [catch {font create xyz} msg] $msg
+} {1 {named font "xyz" already exists}}
+test font-13.4 {CreateNamedFont: recreate "deleted" font} {
+    # not (nfPtr->deletePending == 0)
+    setup
+    font create xyz -family times
+    .b.f configure -font xyz
+    font delete xyz
+    font create xyz -family courier
+    font configure xyz -family
+} {courier}
+
+test font-14.1 {Tk_GetFont procedure} {
+} {}
+
+test font-15.1 {Tk_AllocFontFromObj - converting internal reps} {
+    set x {Times 16}
+    lindex $x 0
+    destroy .b1 .b2
+    button .b1 -font $x
+    lindex $x 0
+    testfont counts {Times 16}
+} {{1 0}}
+test font-15.2 {Tk_AllocFontFromObj - discard stale font} {
+    set x {Times 16}
+    destroy .b1 .b2
+    button .b1 -font $x
+    destroy .b1
+    set result {}
+    lappend result [testfont counts {Times 16}]
+    button .b2 -font $x
+    lappend result [testfont counts {Times 16}]
+} {{} {{1 1}}}
+test font-15.3 {Tk_AllocFontFromObj - reuse existing font} {
+    set x {Times 16}
+    destroy .b1 .b2
+    button .b1 -font $x
+    set result {}
+    lappend result [testfont counts {Times 16}]
+    button .b2 -font $x
+    pack .b1 .b2 -side top
+    lappend result [testfont counts {Times 16}]
+} {{{1 1}} {{2 1}}}
+test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} {
+    # (new == 0)
     setup
     .b.f config -font {-family fixed}
     lindex [font actual {-family fixed}] 0
 } {-family}
-test font-11.2 {Tk_GetFont procedure: bump ref count of named font, too} {
+test font-15.5 {Tk_AllocFontFromObj procedure: get named font} {
+    # (namedHashPtr != NULL) 
     setup
-    font create xyz
-    .b.f config -font xyz
-    lindex [font actual xyz] 0
-} {-family}
-test font-11.3 {Tk_GetFont procedure: get named font} {
+    font create xyz 
+    .b.f config -font xyz 
+} {}
+test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
+    # not (namedHashPtr != NULL)
     setup
-    font create xyz
-    .b.f config -font xyz
+    .b.f config -font {times 20}
 } {}
-test font-11.4 {Tk_GetFont procedure: get native font} {unixOnly} {
+test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} {
+    # not (fontPtr == NULL) 
     setup
     .b.f config -font fixed
 } {}
-test font-11.5 {Tk_GetFont procedure: get native font} {pcOnly} {
+test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} {
+    # not (fontPtr == NULL) 
     setup
     .b.f config -font oemfixed
 } {}
-test font-11.6 {Tk_GetFont procedure: get native font} {macOnly} {
+test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} {
+    # not (fontPtr == NULL) 
     setup
     .b.f config -font application
 } {}
-test font-11.7 {Tk_GetFont procedure: get attribute font} {
+test font-15.10 {Tk_AllocFontFromObj procedure: get attribute font} {
+    # (fontPtr == NULL) 
     list [catch {.b.f config -font {xxx yyy zzz}} msg] $msg
 } {1 {expected integer but got "yyy"}}
-test font-11.8 {Tk_GetFont procedure: get attribute font} {
+test font-15.11 {Tk_AllocFontFromObj procedure: no match} {
+    # (ParseFontNameObj() != TCL_OK)
+    list [catch {font actual "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-15.12 {Tk_AllocFontFromObj procedure: get attribute font} {
+    # not (ParseFontNameObj() != TCL_OK)
     lindex [font actual {plan 9}] 0
 } {-family}
-test font-11.9 {Tk_GetFont procedure: no match} {
-    list [catch {font actual {}} msg] $msg
-} {1 {font "" doesn't exist}}
+test font-15.13 {Tk_AllocFontFromObj procedure: setup tab width} {
+    # Tk_MeasureChars(fontPtr, "0", ...)
+    label .l -bd 0 -padx 0  -highlightthickness 0 -font $fixed -text "a\tb"
+    update
+    set x [winfo reqwidth .l]
+    destroy .l
+    set x
+} [expr [font measure $fixed "0"]*9]
+test font-15.14 {Tk_AllocFontFromObj procedure: underline position} {
+    # (fontPtr->underlineHeight == 0) because size was < 10
+    setup
+    .b.f config -text "underline" -font "times -8 underline"
+    update
+} {}    
 
-test font-12.1 {Tk_NameOfFont procedure} {
+test font-16.1 {Tk_NameOfFont procedure} {
     setup
-    .b.f config -font {-family fixed}
+    .b.f config -font -family\ fixed
     .b.f cget -font
 } {-family fixed}
 
-test font-13.1 {Tk_FreeFont procedure: one ref} {
+test font-17.1 {Tk_FreeFontFromObj - reference counts} {
+    set x {Courier 12}
+    destroy .b1 .b2 .b3
+    button .b1 -font $x
+    button .b3 -font $x
+    button .b2 -font $x
+    set result {}
+    lappend result [testfont counts {Courier 12}]
+    destroy .b1
+    lappend result [testfont counts {Courier 12}]
+    destroy .b2
+    lappend result [testfont counts {Courier 12}]
+    destroy .b3
+    lappend result [testfont counts {Courier 12}]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+test font-17.2 {Tk_FreeFont procedure: one ref} {
+    # (fontPtr->refCount == 0)
     setup
     .b.f config -font {-family fixed}
     destroy .b.f
 } {}
-test font-13.2 {Tk_FreeFont procedure: multiple ref} {
+test font-17.3 {Tk_FreeFont procedure: multiple ref} {
+    # not (fontPtr->refCount == 0)
     setup
     .b.f config -font {-family fixed}
     button .b.b -font {-family fixed}
@@ -364,14 +582,16 @@ test font-13.2 {Tk_FreeFont procedure: multiple ref} {
     destroy .b.b
     set x
 } {-family fixed}
-test font-13.3 {Tk_FreeFont procedure: named font} {
+test font-17.4 {Tk_FreeFont procedure: named font} {
+    # (fontPtr->namedHashPtr != NULL) 
     setup
     font create xyz
     .b.f config -font xyz
     destroy .b.f
     font names
 } {xyz}
-test font-13.4 {Tk_FreeFont procedure: named font} {
+test font-17.5 {Tk_FreeFont procedure: named font} {
+    # not (fontPtr->refCount == 0) 
     setup
     font create xyz -underline 1
     .b.f config -font xyz
@@ -380,9 +600,9 @@ test font-13.4 {Tk_FreeFont procedure: named font} {
     destroy .b.f
     list [font actual xyz -underline] $x
 } {0 1}
-test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} {
+test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} {
     setup
-    font create xyz
+    font create xyz 
     .b.f config -font xyz
     button .b.b -font xyz
     font delete xyz
@@ -391,12 +611,32 @@ test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} {
     list [lindex [font actual xyz] 0] [lindex $x 0]
 } {-family -family}
 
-test font-14.1 {Tk_FontId} {
+test font-18.1 {FreeFontObjProc} {
+    destroy .b1
+    set x [format {Courier 12}]
+    button .b1 -font $x
+    set y [format {Courier 12}]
+    .b1 configure -font $y
+    set z [format {Courier 12}]
+    .b1 configure -font $z
+    set result {}
+    lappend result [testfont counts {Courier 12}]
+    set x red
+    lappend result [testfont counts {Courier 12}]
+    set z 32
+    lappend result [testfont counts {Courier 12}]
+    destroy .b1
+    lappend result [testfont counts {Courier 12}]
+    set y bogus
+    set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+test font-19.1 {Tk_FontId} {
     .b.f config -font "times 20"
     update
 } {}
 
-test font-15.1 {Tk_FontMetrics procedure} {
+test font-20.1 {Tk_GetFontMetrics procedure} {
     button .b.w1 -text abc
     entry .b.w2 -text abcd
     update
@@ -414,7 +654,7 @@ proc psfontname {name} {
     set start [string first "gsave" $post]
     return [string range $post [expr $start+7] end]
 }
-test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
+test font-21.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
     set x [font actual {{itc avant garde} 10} -family]
     if {[string match *avant*garde $x]} {
 	psfontname "{itc avant garde} 10"
@@ -422,25 +662,25 @@ test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
 	set x {AvantGarde-Book}
     }
 } {AvantGarde-Book}
-test font-16.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
     psfontname "arial 10"
 } {Helvetica}
-test font-16.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
     psfontname "{times new roman} 10"
 } {Times-Roman}
-test font-16.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
     psfontname "{courier new} 10"
 } {Courier}
-test font-16.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
     psfontname "geneva 10"
 } {Helvetica}
-test font-16.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
     psfontname "{new york} 10"
 } {Times-Roman}
-test font-16.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
     psfontname "monaco 10"
 } {Courier}
-test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+test font-21.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
     set x [font actual {{lucida bright} 10} -family]
     if {[string match lucida*bright $x]} {
 	psfontname "{lucida bright} 10"
@@ -448,7 +688,7 @@ test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
 	set x {LucidaBright}
     }
 } {LucidaBright}
-test font-16.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
     psfontname "{new century schoolbook} 10"
 } {NewCenturySchlbk-Roman}
 set i 10
@@ -464,7 +704,7 @@ foreach p {
     {"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
     {"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
 } {
-    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
+    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
 	set family [lindex $p 0]
 	set x {}
 	set i 1
@@ -490,7 +730,7 @@ foreach p {
     {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
     {"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
 } {
-    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
+    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
 	set family [lindex $p 0]
 	set x {}
 	foreach slant {roman italic} {
@@ -511,7 +751,7 @@ foreach p {
     {"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
     {"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
 } {
-    test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
+    test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
 	set family [lindex $p 0]
 	set x {}
 	foreach slant {roman italic} {
@@ -524,7 +764,11 @@ foreach p {
     } [lrange $p 1 end]
 }
 
-test font-17.1 {Tk_UnderlineChars procedure} {
+test font-22.1 {Tk_TextWidth procedure} {
+    font measure [.b.l cget -font] "000"
+} [expr $ax*3]
+
+test font-23.1 {Tk_UnderlineChars procedure} {
     text .b.t
     .b.t insert 1.0 abc\tdefg
     .b.t tag config sel -underline 1
@@ -533,39 +777,39 @@ test font-17.1 {Tk_UnderlineChars procedure} {
 } {}
 
 setup
-test font-18.1 {Tk_ComputeTextLayout: empty string} {
+test font-24.1 {Tk_ComputeTextLayout: empty string} {
     .b.l config -text ""
 } {}
-test font-18.2 {Tk_ComputeTextLayout: simple string} {
+test font-24.2 {Tk_ComputeTextLayout: simple string} {
     .b.l config -text "000"
     getsize
 } "[expr $ax*3] $ay"
-test font-18.3 {Tk_ComputeTextLayout: find special chars} {
+test font-24.3 {Tk_ComputeTextLayout: find special chars} {
     .b.l config -text "000\n000"
     getsize
 } "[expr $ax*3] [expr $ay*2]"
-test font-18.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
+test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
     .b.l config -text "000\n000"
     getsize
 } "[expr $ax*3] [expr $ay*2]"
-test font-18.5 {Tk_ComputeTextLayout: break line} {
+test font-24.5 {Tk_ComputeTextLayout: break line} {
     .b.l config -text "000\t00000" -wrap [expr 9*$ax]
     set x [getsize]
     .b.l config -wrap 0
     set x
 } "[expr 8*$ax] [expr 2*$ay]"
-test font-18.6 {Tk_ComputeTextLayout: normal ended on special char} {
+test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} {
     .b.l config -text "000\n000"
 } {}
-test font-18.7 {Tk_ComputeTextLayout: special char was \n} {
+test font-24.7 {Tk_ComputeTextLayout: special char was \n} {
     .b.l config -text "000\n0000"
     getsize
 } "[expr $ax*4] [expr $ay*2]"
-test font-18.8 {Tk_ComputeTextLayout: special char was \t} {
+test font-24.8 {Tk_ComputeTextLayout: special char was \t} {
     .b.l config -text "000\t00"
     getsize
 } "[expr $ax*10] $ay"
-test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} {
+test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} {
     set x {}
     .b.l config -text "000\t000"
     lappend x [getsize]
@@ -574,7 +818,7 @@ test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} {
     .b.l config -wrap 0
     set x
 } "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
-test font-18.10 {Tk_ComputeTextLayout: tab caused break} {
+test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
     set x {}
     .b.l config -text "000\t"
     lappend x [getsize]
@@ -583,7 +827,7 @@ test font-18.10 {Tk_ComputeTextLayout: tab caused break} {
     .b.l config -wrap 0
     set x
 } "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
-test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
+test font-24.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
     set x {}
     .b.l config -text "000            000" -wrap [expr $ax*5]
     lappend x [getsize]
@@ -592,7 +836,7 @@ test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
     .b.l config -wrap 0
     set x
 } "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
-test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
+test font-24.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
     set x {}
     .b.l config -text "000            0000" -wrap [expr $ax*5]
     lappend x [getsize]
@@ -601,14 +845,14 @@ test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
     .b.l config -wrap 0
     set x
 } "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
-test font-18.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
+test font-24.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
     .b.l config -text "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
     getsize
 } "1 [expr $ay*129]"
-test font-18.14 {Tk_ComputeTextLayout: text ended with \n} {
+test font-24.14 {Tk_ComputeTextLayout: text ended with \n} {
     list [.b.l config -text "0000"; getsize] [.b.l config -text "0000\n"; getsize]
 } "{[expr $ax*4] $ay} {[expr $ax*4] [expr $ay*2]}"
-test font-18.15 {Tk_ComputeTextLayout: justification} {
+test font-24.15 {Tk_ComputeTextLayout: justification} {
     csetup "000\n00000"
     set x {}
     .b.c itemconfig text -just left
@@ -621,52 +865,52 @@ test font-18.15 {Tk_ComputeTextLayout: justification} {
     set x
 } {2 1 0}
 
-test font-19.1 {Tk_FreeTextLayout procedure} {
+test font-25.1 {Tk_FreeTextLayout procedure} {
     setup
     .b.f config -text foo
     .b.f config -text boo
 } {}
     
-test font-20.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
+test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
     .b.f config -text foo
 } {}
-test font-20.2 {Tk_DrawTextLayout procedure: multiple chunks} {
+test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} {
     csetup "000\t00\n000"
 } {}
-test font-20.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
+test font-26.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
     csetup "000\t00"
     .b.c select from text 3
     .b.c select to text 5
 } {}
-test font-20.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
+test font-26.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
     .b.c select from text 3
     .b.c select to text 5
 } {}
-test font-20.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
+test font-26.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
     .b.c select from text 2
     .b.c select to text 2
 } {}
-test font-20.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
+test font-26.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
     .b.c select from text 4
     .b.c select to text 4
 } {}
 
-test font-21.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
+test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
     .b.f config -text "foo" -under -1
 } {}
-test font-21.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
+test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
     .b.f config -text "000          00000" -wrap [expr $ax*7] -under 10
 } {}
-test font-21.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
+test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
     .b.f config -text "000          00000" -wrap [expr $ax*7] -under 5
     .b.f config -wrap -1 -under -1
 } {}
     
-test font-22.1 {Tk_PointToChar procedure: above all lines} {
+test font-28.1 {Tk_PointToChar procedure: above all lines} {
     csetup "000"
     .b.c index text @-1,0
 } {0}
-test font-22.2 {Tk_PointToChar procedure: no chars} {
+test font-28.2 {Tk_PointToChar procedure: no chars} {
     # After fixing the following bug:
     #
     # In canvas text item, it was impossible to click to position the
@@ -678,103 +922,103 @@ test font-22.2 {Tk_PointToChar procedure: no chars} {
     csetup ""
     .b.c index text @100,100
 } {0}
-test font-22.3 {Tk_PointToChar procedure: loop test} {
+test font-28.3 {Tk_PointToChar procedure: loop test} {
     csetup "000\n000\n000\n000"
     .b.c index text @10000,0
 } {3}
-test font-22.4 {Tk_PointToChar procedure: intersect line} {
+test font-28.4 {Tk_PointToChar procedure: intersect line} {
     csetup "000\n000\n000"
     .b.c index text @0,$ay
 } {4}
-test font-22.5 {Tk_PointToChar procedure: to the left of all chunks} {
+test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} {
     .b.c index text @-100,$ay
 } {4}
-test font-22.6 {Tk_PointToChar procedure: past any possible chunk} {
+test font-28.6 {Tk_PointToChar procedure: past any possible chunk} {
     .b.c index text @100000,$ay
 } {7}
-test font-22.7 {Tk_PointToChar procedure: which chunk on this line} {
+test font-28.7 {Tk_PointToChar procedure: which chunk on this line} {
     csetup "000\n000\t000\t000\n000"
     .b.c index text @[expr $ax*2],$ay
 } {6}
-test font-22.8 {Tk_PointToChar procedure: which chunk on this line} {
+test font-28.8 {Tk_PointToChar procedure: which chunk on this line} {
     csetup "000\n000\t000\t000\n000"
     .b.c index text @[expr $ax*10],$ay
 } {10}
-test font-22.9 {Tk_PointToChar procedure: in special chunk} {
+test font-28.9 {Tk_PointToChar procedure: in special chunk} {
     csetup "000\n000\t000\t000\n000"
     .b.c index text @[expr $ax*6],$ay
 } {7}
-test font-22.10 {Tk_PointToChar procedure: past all chars in chunk} {
+test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} {
     csetup "000 0000000"
     .b.c itemconfig text -width [expr $ax*5]
     set x [.b.c index text @[expr $ax*5],0]
     .b.c itemconfig text -width 0
     set x
 } {3}
-test font-22.11 {Tk_PointToChar procedure: below all chunks} {
+test font-28.11 {Tk_PointToChar procedure: below all chunks} {
     csetup "000 0000000"
     .b.c index text @0,1000000
 } {11}
     
-test font-23.1 {Tk_CharBBox procedure: index < 0} {
+test font-29.1 {Tk_CharBBox procedure: index < 0} {
     .b.f config -text "000" -underline -1
 } {}
-test font-23.2 {Tk_CharBBox procedure: loop} {
+test font-29.2 {Tk_CharBBox procedure: loop} {
     .b.f config -text "000\t000\t000\t000" -underline 9
 } {}
-test font-23.3 {Tk_CharBBox procedure: special char} {
+test font-29.3 {Tk_CharBBox procedure: special char} {
     .b.f config -text "000\t000\t000" -underline 7
 } {}
-test font-23.4 {Tk_CharBBox procedure: normal char} {
+test font-29.4 {Tk_CharBBox procedure: normal char} {
     .b.f config -text "000" -underline 1
 } {}
-test font-23.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
+test font-29.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
     .b.f config -text "0    0000" -wrap [expr $ax*4] -under 2
     .b.f config -wrap 0
 } {}
-test font-23.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
+test font-29.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
     .b.f config -text "0    0000" -wrap [expr $ax*4] -under 3
     .b.f config -wrap 0
 } {}
 
 .b.c bind all <Enter> {lappend x [.b.c index current @%x,%y]}
 
-test font-24.1 {Tk_TextLayoutToPoint procedure: loop once} {
+test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} {
     csetup "000\n000\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x 0 -y 0
     set x
 } {0}
-test font-24.2 {Tk_TextLayoutToPoint procedure: loop multiple} {
+test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} {
     csetup "000\n000\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x $ax -y $ay
     set x
 } {5}
-test font-24.3 {Tk_TextLayoutToPoint procedure: loop to end} {
+test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} {
     csetup "000\n0\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x [expr $ax*2] -y $ay
     set x
 } {}
-test font-24.4 {Tk_TextLayoutToPoint procedure: hit a special char (tab)} {
+test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} {
     csetup "000\t000\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x [expr $ax*6] -y 0
     set x
 } {3}
-test font-24.5 {Tk_TextLayoutToPoint procedure: ignore newline} {
+test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} {
     csetup "000\n0\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x [expr $ax*2] -y $ay
     set x
 } {}
-test font-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} {
+test font-30.6 {Tk_DistanceToTextLayout procedure: ignore spaces at eol} {
     csetup "000\n000      000000000"
     .b.c itemconfig text -width [expr $ax*10]
     set x {}
@@ -784,42 +1028,42 @@ test font-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} {
     set x
 } {}
 .b.c itemconfig text -justify center
-test font-24.7 {Tk_TextLayoutToPoint procedure: on left side} {
+test font-30.7 {Tk_DistanceToTextLayout procedure: on left side} {
     csetup "0\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x 0 -y 0
     set x
 } {}
-test font-24.8 {Tk_TextLayoutToPoint procedure: on right side} {
+test font-30.8 {Tk_DistanceToTextLayout procedure: on right side} {
     csetup "0\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x [expr $ax*2] -y 0
     set x
 } {}
-test font-24.9 {Tk_TextLayoutToPoint procedure: inside line} {
+test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} {
     csetup "0\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x $ax -y 0
     set x
 } {0}
-test font-24.10 {Tk_TextLayoutToPoint procedure: above line} {
+test font-30.10 {Tk_DistanceToTextLayout procedure: above line} {
     csetup "0\n000"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x 0 -y 0
     set x
 } {}
-test font-24.11 {Tk_TextLayoutToPoint procedure: below line} {
+test font-30.11 {Tk_DistanceToTextLayout procedure: below line} {
     csetup "000\n0"
     set x {}
     event generate .b.c <Leave>
     event generate .b.c <Enter> -x 0 -y $ay
     set x
 } {}
-test font-24.12 {Tk_TextLayoutToPoint procedure: in line} {
+test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
     csetup "0\n000"
     set x {}
     event generate .b.c <Leave>
@@ -827,7 +1071,7 @@ test font-24.12 {Tk_TextLayoutToPoint procedure: in line} {
     set x
 } {3}
 .b.c itemconfig text -justify left
-test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} {
+test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
     csetup "000"
     set x {}
     event generate .b.c <Leave>
@@ -835,27 +1079,27 @@ test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} {
     set x
 } {1}
 
-test font-25.1 {Tk_TextLayoutToArea procedure: loop once} {
+test font-31.1 {Tk_IntersectTextLayout procedure: loop once} {
     csetup "000\n000\n000"
     .b.c find overlapping 0 0 0 0
 } [.b.c find withtag text]
-test font-25.2 {Tk_TextLayoutToArea procedure: loop multiple} {
+test font-31.2 {Tk_IntersectTextLayout procedure: loop multiple} {
     csetup "000\t000\t000"
     .b.c find overlapping [expr $ax*10] 0 [expr $ax*10] 0
 } [.b.c find withtag text]
-test font-25.3 {Tk_TextLayoutToArea procedure: loop to end} {
+test font-31.3 {Tk_IntersectTextLayout procedure: loop to end} {
     csetup "0\n000"
     .b.c find overlapping [expr $ax*2] 0 [expr $ax*2] 0
 } {}
-test font-25.4 {Tk_TextLayoutToArea procedure: hit a special char (tab)} {
+test font-31.4 {Tk_IntersectTextLayout procedure: hit a special char (tab)} {
     csetup "000\t000"
     .b.c find overlapping [expr $ax*6] 0 [expr $ax*6] 0
 } [.b.c find withtag text]
-test font-25.5 {Tk_TextLayoutToArea procedure: ignore newlines} {
+test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} {
     csetup "000\n0\n000"
     .b.c find overlapping $ax $ay $ax $ay
 } {}
-test font-25.6 {Tk_TextLayoutToArea procedure: ignore spaces at eol} {
+test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} {
     csetup "000\n000      000000000"
     .b.c itemconfig text -width [expr $ax*10]
     set x [.b.c find overlapping [expr $ax*5] $ay [expr $ax*5] $ay]
@@ -863,7 +1107,7 @@ test font-25.6 {Tk_TextLayoutToArea procedure: ignore spaces at eol} {
     set x
 } {}
 
-test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
+test font-32.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
     # If there were a whole bunch of returns or tabs in a row, then the
     # temporary buffer could overflow and write on the stack.
     
@@ -910,29 +1154,19 @@ test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
 (end)
 }
 
-test font-27.1 {Tk_TextWidth procedure} {
-    font measure [.b.l cget -font] "000"
-} [expr $ax*3]
-
-test font-28.1 {SetupFontMetrics procedure} {
-    setup
-    .b.f config -font $fixed
+test font-33.1 {Tk_TextWidth procedure} {
 } {}
 
-test font-29.1 {TkInitFontAttributes procedure} {
+test font-33.2 {ConfigAttributesObj procedure: arguments} {
+    # (Tcl_GetIndexFromObj() != TCL_OK)
     setup
-    font create xyz
-    font config xyz
-} {-family {} -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
-
-test font-30.1 {ConfigAttributes procedure: arguments} {
+    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} {
+    # (objc & 1)
     setup
     list [catch {font create xyz -family} msg] $msg
-} {1 {missing value for "-family" option}}
-test font-30.2 {ConfigAttributes procedure: arguments} {
-    setup
-    list [catch {font create xyz -xyz xyz} msg] $msg
-} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+} {1 {value for "-family" option missing}}
 set i 3
 foreach p {
     {family xyz times}
@@ -943,7 +1177,7 @@ foreach p {
     {overstrike 0 1}
 } {
     set opt [lindex $p 0]
-    test font-30.$i "ConfigAttributes procedure: $opt" {
+    test font-34.$i "ConfigAttributesObj procedure: $opt" {
 	setup
 	set x {}
 	font create xyz -$opt [lindex $p 1]
@@ -955,27 +1189,37 @@ foreach p {
 }
 foreach p {
     {size	xyz {1 {expected integer but got "xyz"}}}
-    {weight	xyz {1 {bad -weight value "xyz": must be normal, bold}}}
-    {slant	xyz {1 {bad -slant value "xyz": must be roman, italic}}}
+    {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"}}}
 } {
-    test font-30.$i "ConfigAttributes procedure: [lindex $p 0]" {
+    test font-34.$i "ConfigAttributesObj procedure: [lindex $p 0]" {
 	setup
 	list [catch {font create xyz -[lindex $p 0] [lindex $p 1]} msg] $msg
     } [lindex $p 2]
     incr i
 }
 
-test font-31.1 {GetAttributeInfo procedure: error} {
-    list [catch {font actual xyz -style} msg] $msg
-} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-31.2 {GetAttributeInfo procedure: all attributes} {
+test font-35.1 {GetAttributeInfoObj procedure: one attribute} {
+    # (objPtr != NULL)
+    setup
+    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
     font create xyz -family xyz
     font config xyz
 } {-family xyz -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
-set i 3
+set i 4
 foreach p {
     {family	xyz	xyz}
     {size	20	20}
@@ -993,100 +1237,153 @@ foreach p {
 }
 
 # In tests below, one field is set to "xyz" so that font name doesn't
-# look like a native X font, so that ParseFontName or TkParseXLFD will
+# look like a native X font, so that ParseFontNameObj or TkParseXLFD will
 # be called.
 
 setup
 
-test font-32.1 {ParseFontName procedure: begins with -} {
+test font-38.1 {ParseFontNameObj procedure: begins with -} {
     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
 } $times
-test font-32.2 {ParseFontName procedure: begins with -*} {
+test font-38.2 {ParseFontNameObj procedure: begins with -*} {
     lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
 } $times
-test font-32.3 {ParseFontName procedure: begins with -, doesn't look like list} {
+test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} {
     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
 } $times
-test font-32.4 {ParseFontName procedure: begins with -, looks like list} {
+test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} {
     lindex [font actual {-family times}] 1
 } $times
-test font-32.5 {ParseFontName procedure: begins with *} {
+test font-38.5 {ParseFontNameObj procedure: begins with *} {
     lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
 } $times
-test font-32.6 {ParseFontName procedure: begins with *} {
+test font-38.6 {ParseFontNameObj procedure: begins with *} {
     font actual *-times-xyz -family
 } $times
-test font-32.7 {ParseFontName procedure: arguments} {
-    list [catch {font actual {}} msg] $msg
+test font-38.7 {ParseFontNameObj procedure: arguments} {
+    list [catch {font actual "\{xyz"} msg] $msg
+} [list 1 "font \"{xyz\" doesn't exist"]
+test font-38.8 {ParseFontNameObj procedure: arguments} {
+    list [catch {font actual ""} msg] $msg
 } {1 {font "" doesn't exist}}
-test font-32.8 {ParseFontName procedure: arguments} {
+test font-38.9 {ParseFontNameObj procedure: arguments} {
     list [catch {font actual {times 20 xyz xyz}} msg] $msg
 } {1 {unknown font style "xyz"}}
-test font-32.9 {ParseFontName procedure: arguments} {
+test font-38.10 {ParseFontNameObj procedure: arguments} {
     list [catch {font actual {times xyz xyz}} msg] $msg
 } {1 {expected integer but got "xyz"}}
-test font-32.10 {ParseFontName procedure: stylelist loop} {macOnly} {
+test font-38.11 {ParseFontNameObj procedure: stylelist loop} {macOnly} {
     lrange [font actual {times 12 bold italic overstrike underline}] 4 end
 } {-weight bold -slant italic -underline 1 -overstrike 0}
-test font-32.11 {ParseFontName procedure: stylelist loop} {unixOrPc} {
+test font-38.12 {ParseFontNameObj procedure: stylelist loop} {unixOrPc} {
     lrange [font actual {times 12 bold italic overstrike underline}] 4 end
 } {-weight bold -slant italic -underline 1 -overstrike 1}
-test font-32.12 {ParseFontName procedure: stylelist error} {
+test font-38.13 {ParseFontNameObj procedure: stylelist error} {
     list [catch {font actual {times 12 bold xyz}} msg] $msg
 } {1 {unknown font style "xyz"}}
 
-test font-33.1 {TkParseXLFD procedure: initial dash} {
+test font-39.1 {NewChunk procedure: test realloc} {
+    .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
+} {}
+
+test font-40.1 {TkFontParseXLFD procedure: initial dash} {
     font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-* -family
 } $times
-test font-33.2 {TkParseXLFD procedure: no initial dash} {
+test font-40.2 {TkFontParseXLFD procedure: no initial dash} {
     font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
 } $times
-test font-33.3 {TkParseXLFD procedure: not enough fields} {
+test font-40.3 {TkFontParseXLFD procedure: not enough fields} {
     font actual -xyz-times-*-*-* -family
 } $times
-test font-33.4 {TkParseXLFD procedure: all fields unspecified} {
+test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} {
     lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
 } {-family}
-test font-33.5 {TkParseXLFD procedure: all fields specified} {
+test font-40.5 {TkFontParseXLFD procedure: all fields specified} {
     lindex [font actual -foundry-times-weight-slant-setwidth-addstyle-10-10-10-10-spacing-avgwidth-registry-encoding] 1
 } $times
-test font-33.6 {TkParseXLFD procedure: arguments} {
+test font-41.1 {TkParseXLFD procedure: arguments} {
     # XLFD with bad pointsize: fallback to some system font.
     font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
     set x {}
 } {}
-test font-33.7 {TkParseXLFD procedure: arguments} {
+test font-42.1 {TkFontParseXLFD procedure: arguments} {
     # XLFD with bad pixelsize: fallback to some system font.
     font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
     set x {}
 } {}
-test font-33.8 {TkParseXLFD procedure: pixelsize specified} {
+test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} {
     font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
     set x {}
 } {}
-test font-33.9 {TkParseXLFD procedure: weird pixelsize specified} {
+test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} {
     font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
     set x {}
 } {}
-test font-33.10 {TkParseXLFD procedure: pointsize specified} {
+test font-42.4 {TkFontParseXLFD procedure: pointsize specified} {
     font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
     set x {}
 } {}
-test font-33.11 {TkParseXLFD procedure: weird pointsize specified} {
+test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} {
     font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
     set x {}
 } {}
 
-test font-34.1 {FieldSpecified procedure: specified vs. non-specified} {
+test font-43.1 {FieldSpecified procedure: specified vs. non-specified} {
     font actual -xyz--*-*-*-*-*-*-*-*-*-*-*-*
     font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*
     font actual -xyz-?-*-*-*-*-*-*-*-*-*-*-*-*
     lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
 } $times
 
-test font-35.1 {NewChunk procedure: test realloc} {
-    .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
-} {}
+set oldscale [tk scaling]
+tk scaling 0.5
+test font-44.1 {TkFontGetPixels: size < 0} {
+    font actual {times -12} -size
+} {24}
+test font-44.2 {TkFontGetPixels: size >= 0} {
+    font actual {times 12} -size
+} {12}
+
+test font-45.1 {TkFontGetPoints: size >= 0} {
+    font actual {times 12} -size
+} {12}
+test font-45.2 {TkFontGetPoints: size < 0} {
+    font actual {times -12} -size
+} {24}
+
+tk scaling $oldscale
+
+test font-46.1 {TkFontGetAliasList: no match} {
+    font actual {snarky 10} -family
+} [font actual {-size 10} -family]
+test font-46.2 {TkFontGetAliasList: match} {macOnly} {
+    # Result could be either "Times" or "New York"
+    font actual {{times new roman} 10} -family
+} [font actual {times 10} -family]
+test font-46.3 {TkFontGetAliasList: match} {pcOnly} {
+    font actual {times 10} -family
+} {Times New Roman}
+test font-46.4 {TkFontGetAliasList: match} {unixOnly} {
+    font actual {{times new roman} 10} -family
+} [font actual {times 10} -family]
+
+setup
 
 destroy .b
+
+# cleanup
+::tcltest::cleanupTests
 return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/frame.test b/tests/frame.test
index 7e3d8da..370f674 100644
--- a/tests/frame.test
+++ b/tests/frame.test
@@ -4,14 +4,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: frame.test,v 1.2 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: frame.test,v 1.3 1999/04/16 01:51:37 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -615,3 +614,20 @@ test frame-11.2 {TkInstallFrameMenu - frame renamed} {
 catch {destroy .f}
 rename eatColors {}
 rename colorsFree {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/geometry.test b/tests/geometry.test
index 0785ab1..615ccc7 100644
--- a/tests/geometry.test
+++ b/tests/geometry.test
@@ -4,14 +4,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: geometry.test,v 1.2 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: geometry.test,v 1.3 1999/04/16 01:51:37 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -247,5 +246,22 @@ test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
     update
     winfo ismapped .t.quit
 } {1}
+
 catch {destroy .t}
-concat
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/get.test b/tests/get.test
new file mode 100644
index 0000000..bf6dc44
--- /dev/null
+++ b/tests/get.test
@@ -0,0 +1,97 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkGet.c.  It is organized in the standard fashion for Tcl
+# white-box tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: get.test,v 1.2 1999/04/16 01:51:38 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+button .b
+test get-1.1 {Tk_GetAnchorFromObj} {
+    .b configure -anchor n
+    .b cget -anchor
+} {n}
+test get-1.2 {Tk_GetAnchorFromObj} {
+    .b configure -anchor ne
+    .b cget -anchor
+} {ne}
+test get-1.3 {Tk_GetAnchorFromObj} {
+    .b configure -anchor e
+    .b cget -anchor
+} {e}
+test get-1.4 {Tk_GetAnchorFromObj} {
+    .b configure -anchor se
+    .b cget -anchor
+} {se}
+test get-1.5 {Tk_GetAnchorFromObj} {
+    .b configure -anchor s
+    .b cget -anchor
+} {s}
+test get-1.6 {Tk_GetAnchorFromObj} {
+    .b configure -anchor sw
+    .b cget -anchor
+} {sw}
+test get-1.7 {Tk_GetAnchorFromObj} {
+    .b configure -anchor w
+    .b cget -anchor
+} {w}
+test get-1.8 {Tk_GetAnchorFromObj} {
+    .b configure -anchor nw
+    .b cget -anchor
+} {nw}
+test get-1.9 {Tk_GetAnchorFromObj} {
+    .b configure -anchor n
+    .b cget -anchor
+} {n}
+test get-1.10 {Tk_GetAnchorFromObj} {
+    .b configure -anchor center
+    .b cget -anchor
+} {center}
+test get-1.11 {Tk_GetAnchorFromObj - error} {
+    list [catch {.b configure -anchor unknown} msg] $msg
+} {1 {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center}}
+
+catch {destroy .b}
+button .b
+test get-2.1 {Tk_GetJustifyFromObj} {
+    .b configure -justify left
+    .b cget -justify
+} {left}
+test get-2.2 {Tk_GetJustifyFromObj} {
+    .b configure -justify right
+    .b cget -justify
+} {right}
+test get-2.3 {Tk_GetJustifyFromObj} {
+    .b configure -justify center
+    .b cget -justify
+} {center}
+test get-2.4 {Tk_GetJustifyFromObj - error} {
+    list [catch {.b configure -justify stupid} msg] $msg
+} {1 {bad justification "stupid": must be left, right, or center}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/grid.test b/tests/grid.test
index 85464d7..ed0a455 100644
--- a/tests/grid.test
+++ b/tests/grid.test
@@ -3,14 +3,13 @@
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: grid.test,v 1.3 1999/01/06 21:10:46 stanton Exp $
+# RCS: @(#) $Id: grid.test,v 1.4 1999/04/16 01:51:38 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source ../tests/defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 # helper routine to return "." to a sane state after a test
 # The variable GRID_VERBOSE can be used to "look" at the result
@@ -319,7 +318,7 @@ test grid-6.8 {location (weights)} {
 } {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}}
 grid_reset 6.8
 
-test grid-6.9 {location: check updates pending} {
+test grid-6.9 {location: check updates pending} {nonPortable} {
 	set a ""
 	foreach i {0 1 2} {
 	    frame .$i -width 120 -height 75 -bg red
@@ -989,23 +988,26 @@ test grid-14.2 {structure notify} {
 } {{0 0 200 100,0 0 200 100} {0 0 240 140,20 20 200 100}}
 grid_reset 14.2
 
-test grid-14.3 {map notify} {
-	global A
-	catch {unset A}
-	bind . <Configure> {incr A(%W)}
-	set A(.) 0
-	foreach i {0 1 2} {
-		frame .$i -width 100 -height 75
-		set A(.$i) 0
-	}
-	grid .0 .1 .2
-	update
-	bind <Configure> .1 {destroy .0}
-	.2 configure -bd 10
-	update
-	bind . <Configure> {}
-	array get A
-} {.2 2 .0 1 . 1 .1 1}
+test grid-14.3 {map notify: bug 1648} {nonPortable} {
+    # This test is nonPortable because the number of times
+    # A(.) will be incremented is unspecified--the behavior
+    # is different accross window managers.
+    global A
+    catch {unset A}
+    bind . <Configure> {incr A(%W)}
+    set A(.) 0
+    foreach i {0 1 2} {
+	frame .$i -width 100 -height 75
+	set A(.$i) 0
+    }
+    grid .0 .1 .2
+    update
+    bind <Configure> .1 {destroy .0}
+    .2 configure -bd 10
+    update
+    bind . <Configure> {}
+    array get A
+} {.2 2 .0 1 . 2 .1 1}
 grid_reset 14.3
 
 test grid-15.1 {lost slave} {
@@ -1212,3 +1214,20 @@ test grid-17.1 {forget and pending idle handlers} {
     destroy .t
     set result ok
 } ok
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/id.test b/tests/id.test
index b1c2ea9..8c12a50 100644
--- a/tests/id.test
+++ b/tests/id.test
@@ -3,19 +3,19 @@
 # the standard fashion for Tcl tests.
 #
 # Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: id.test,v 1.3 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: id.test,v 1.4 1999/04/16 01:51:38 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 if {[string compare testwrapper [info commands testwrapper]] != 0} {
     puts "This application hasn't been compiled with the testwrapper command,"
     puts "therefore I am skipping all of these tests."
+    ::tcltest::cleanupTests
     return
 }
 
@@ -100,3 +100,20 @@ test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly} {
     lappend result [lsort $reused] [lsort $x]
 } {{.f .f.a .f.b .f.c .f.d .f.e .f.f .f.g .f.h .f.i .f.j .f.k .f.l .f.m .f.n .f.o .f.p .f.q} {} {} {.f.o .f.p .f.q wrapper.f.p wrapper.f.q} {}}
 bind all <Destroy> {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/image.test b/tests/image.test
index 468865d..e3f7841 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -4,23 +4,23 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: image.test,v 1.2 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: image.test,v 1.3 1999/04/16 01:51:38 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 foreach i [winfo children .] {
     destroy $i
 }
@@ -355,3 +355,20 @@ test image-13.1 {image command vs hidden commands} {
     
 destroy .c
 eval image delete [image names]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/imgBmap.test b/tests/imgBmap.test
index 337a136..ffdafeb 100644
--- a/tests/imgBmap.test
+++ b/tests/imgBmap.test
@@ -4,14 +4,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: imgBmap.test,v 1.2 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: imgBmap.test,v 1.3 1999/04/16 01:51:38 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -472,3 +471,20 @@ removeFile foo.bm
 removeFile foo2.bm
 destroy .c
 eval image delete [image names]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/imgPPM.test b/tests/imgPPM.test
index f9ffc9e..00abf33 100644
--- a/tests/imgPPM.test
+++ b/tests/imgPPM.test
@@ -3,14 +3,13 @@
 # The files is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: imgPPM.test,v 1.2 1998/09/14 18:23:47 stanton Exp $
+# RCS: @(#) $Id: imgPPM.test,v 1.3 1999/04/16 01:51:38 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -154,3 +153,20 @@ test imgPPM-3.13 {ReadPPMFileHeader procedure, file ends too soon} {
 removeFile test.ppm
 removeFile test2.ppm
 eval image delete [image names]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index d3a9dcc..0ee4489 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -4,16 +4,15 @@
 #
 # Copyright (c) 1994 The Australian National University
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
 # Author: Paul Mackerras (paulus@cs.anu.edu.au)
 #
-# RCS: @(#) $Id: imgPhoto.test,v 1.3 1998/12/07 23:29:00 hershey Exp $
+# RCS: @(#) $Id: imgPhoto.test,v 1.4 1999/04/16 01:51:38 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -28,13 +27,20 @@ canvas .c
 pack .c
 update
 
+# temporarily copy the README fiel from testsDir to tmpDir
+if {![file exists README]} {
+    set newREADME [file join $::tcltest::workingDir README]
+    file copy [file join $::tcltest::testsDir README] $newREADME
+    set removeREADME 1
+}
+
 # find the teapot.ppm file for use in these tests
 # first look in $tk_library/demos/images/teapot.ppm
 # then look in <this file>/../../library/demos/images/teapot.ppm
 # skip this file if you can't find the teapot.ppm file.
 set teapotPhotoFile [file join $tk_library demos images teapot.ppm]
 if {![file exists $teapotPhotoFile]} {
-    set newLib [file dirname [file dirname [info script]]]
+    set newLib [file dirname $::tcltest::testsDir]
     set teapotPhotoFile \
 	[file join $newLib library demos images teapot.ppm]
     if {![file exists $teapotPhotoFile]} {
@@ -432,3 +438,23 @@ test imgPhoto-13.1 {check separation of images in different interpreters} {
 
 destroy .c
 eval image delete [image names]
+
+# cleanup
+if {[info exists removeREADME]} {
+    catch {file delete -force $newREADME}
+}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/listbox.test b/tests/listbox.test
index c2b1447..3c124df 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -3,14 +3,14 @@
 #
 # Copyright (c) 1993-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: listbox.test,v 1.2 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: listbox.test,v 1.3 1999/04/16 01:51:38 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 foreach i [winfo children .] {
     destroy $i
@@ -1656,3 +1656,19 @@ catch {destroy .e}
 catch {destroy .partial}
 option clear
 
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/macEmbed.test b/tests/macEmbed.test
index 90b7161..67a77a0 100644
--- a/tests/macEmbed.test
+++ b/tests/macEmbed.test
@@ -3,18 +3,13 @@
 # tests.
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: macEmbed.test,v 1.3 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: macEmbed.test,v 1.4 1999/04/16 01:51:38 stanton Exp $
 
-if {$tcl_platform(platform) != "macintosh"} {
-    return
-}
-
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 eval destroy [winfo children .]
@@ -22,11 +17,11 @@ wm geometry . {}
 raise .
 
 
-test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {
+test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} {
     catch {destroy .t}
     list [catch {toplevel .t -use xyz} msg] $msg
 } {1 {expected integer but got "xyz"}}
-test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
+test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} {
     catch {destroy .t}
     list [catch {toplevel .t -use 47} msg] $msg
 } {1 {The window ID 47 does not correspond to a valid Tk Window.}}
@@ -34,10 +29,11 @@ test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
 if {[string compare testembed [info commands testembed]] != 0} {
     puts "This application hasn't been compiled with the testembed command,"
     puts "therefore I am skipping all of these tests."
+    ::tcltest::cleanupTests
     return
 }
 
-test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {
+test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly} {
     eval destroy [winfo child .]
     frame .f1 -container 1 -width 200 -height 50
     frame .f2 -container 1 -width 200 -height 50
@@ -46,7 +42,7 @@ test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {
 	toplevel .t -use $w
 	list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w]
 } {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0}
-test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {
+test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {macOnly} {
     eval destroy [winfo child .]
     frame .f1 -container 1 -width 200 -height 50
     frame .f2 -container 1 -width 200 -height 50
@@ -61,7 +57,7 @@ test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {
 # Can't think of any way to test the procedures TkpMakeWindow,
 # TkpMakeContainer, or EmbedErrorProc.
 
-test macEmbed-2.1 {EmbeddedEventProc procedure} {
+test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -74,7 +70,7 @@ test macEmbed-2.1 {EmbeddedEventProc procedure} {
     update
 	testembed
 } {}
-test macEmbed-2.2 {EmbeddedEventProc procedure} {
+test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -85,7 +81,7 @@ test macEmbed-2.2 {EmbeddedEventProc procedure} {
     destroy .f1
     testembed
 } {}
-test macEmbed-2.3 {EmbeddedEventProc procedure} {
+test macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -98,7 +94,7 @@ test macEmbed-2.3 {EmbeddedEventProc procedure} {
     list [testembed] [winfo children .]
 } {{} {}}
 
-test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {
+test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -110,7 +106,8 @@ test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {
 	wm withdraw .t1
     list $x [testembed]
 } {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
-test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} {
+test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
+	{macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -123,7 +120,8 @@ test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} {
     update
 	wm geometry .t1
 } {200x200+0+0}
-test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} {
+test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
+	{macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -136,7 +134,7 @@ test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} {
     update
 	wm geometry .t1
 } {300x100+0+0}
-test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {
+test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -148,7 +146,7 @@ test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {
     update
     list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
 } {300 80 300x80+0+0}
-test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {
+test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -163,7 +161,7 @@ test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {
 	update
 	set x
 } {mapped}
-test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {
+test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -179,7 +177,7 @@ test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {
     list $x [winfo exists .f1]
 } {dead 0}
 
-test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {
+test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -192,7 +190,7 @@ test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {
     update
 	winfo geometry .t1
 } {180x100+0+0}
-test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {
+test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -208,7 +206,7 @@ test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {
 
 # Can't think up any tests for TkpGetOtherWindow procedure.
 
-test unixEmbed-5.1 {TkpClaimFocus procedure} {tempNotMac} {
+test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
     catch {interp delete child}
     foreach w [winfo child .] {
 	catch {destroy $w}
@@ -233,7 +231,7 @@ test unixEmbed-5.1 {TkpClaimFocus procedure} {tempNotMac} {
 } {{{} .} .f1}
 catch {interp delete child}
 
-test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {
+test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -250,7 +248,7 @@ test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {
     }
     set x
 } {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
-test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {
+test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -265,7 +263,7 @@ test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {
 	lappend x [testembed]
 } {{{XXX .f1 XXX .t1}} {}}
 
-test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
+test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -277,7 +275,7 @@ test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
     update
     wm geometry .t1
 } {150x80+0+0}
-test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
+test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
     foreach w [winfo child .] {
 	catch {destroy $w}
     }
@@ -295,3 +293,20 @@ test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
 foreach w [winfo child .] {
     catch {destroy $w}
 }
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/macFont.test b/tests/macFont.test
index 8c6d0ae..7bec629 100644
--- a/tests/macFont.test
+++ b/tests/macFont.test
@@ -7,28 +7,30 @@
 # but there are no results that can be checked.  
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: macFont.test,v 1.2 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: macFont.test,v 1.3 1999/04/16 01:51:38 stanton Exp $
 
-if {$tcl_platform(platform)!="macintosh"} {
-    return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
-if {[string compare test [info procs test]] != 0} {
-    source defs
+if {$tcl_platform(platform)!="macintosh"} {
+    puts "skipping: Mac only tests..."
+    ::tcltest::cleanupTests
+    return
 }
 
 catch {destroy .b}
 toplevel .b
 update idletasks
 
-set courier {Courier 10}
+set courier {Courier 12}
 set cx [font measure $courier 0]
 
-label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Monaco 9"
+set fixed {Monaco 12}
+label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font $fixed
 pack .b.l
 canvas .b.c -closeenough 0
 
@@ -43,125 +45,226 @@ proc getsize {} {
     return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
 }
 
-test macfont-1.1 {TkpGetNativeFont procedure: not native} {
+set ::tcltest::testConfig(gothic) 0
+set gothic {gothic 12}
+set mx [font measure  $gothic \u4e4e]
+if {[font actual $gothic -family] != [font actual system -family]} {
+    set ::tcltest::testConfig(gothic) 1
+}
+
+test macFont-1.1 {TkpFontPkgInit} {
+} {}
+
+test macfont-2.1 {TkpGetNativeFont: not native} {
     list [catch {font measure {} xyz} msg] $msg
 } {1 {font "" doesn't exist}}
-test macfont-1.2 {TkpGetNativeFont procedure: native} {
+test macFont-2.2 {TkpGetNativeFont: native} {
     font measure system "0"
     font measure application "0"
     set x {}
 } {}
 
-test macfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
+test macFont-3.1 {TkpGetFontFromAttributes: no family} {
     font actual {-underline 1} -family
 } [font actual system -family]
-test macfont-2.2 {TkpGetFontFromAttributes procedure: long family name} {
+test macFont-3.2 {TkpGetFontFromAttributes: long family name} {
     set x "12345678901234567890123456789012345678901234567890"
     set x "$x$x$x$x$x$x"
     font actual "-family $x" -family
 } [font actual system -family]
-test macfont-2.3 {TkpGetFontFromAttributes procedure: family} {
+test macFont-3.3 {TkpGetFontFromAttributes: family} {
     font actual {-family Courier} -family
 } {Courier}
-test macfont-2.4 {TkpGetFontFromAttributes procedure: Times fonts} {
+test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} {
     set x {}
     lappend x [font actual {-family "Times"} -family]
     lappend x [font actual {-family "Times New Roman"} -family]
 } {Times Times}
-test macfont-2.5 {TkpGetFontFromAttributes procedure: Courier fonts} {
+test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} {
     set x {}
     lappend x [font actual {-family "Courier"} -family]
     lappend x [font actual {-family "Courier New"} -family]
 } {Courier Courier}
-test macfont-2.6 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
+test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} {
     set x {}
     lappend x [font actual {-family "Geneva"} -family]
     lappend x [font actual {-family "Helvetica"} -family]
     lappend x [font actual {-family "Arial"} -family]
 } {Geneva Helvetica Helvetica}
-test macfont-2.7 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.7 {TkpGetFontFromAttributes: try aliases} {
+    font actual {arial 10} -family
+} {Helvetica}    
+test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} {
+    font actual {{ms sans serif} 10} -family
+} {Chicago}
+test macFont-3.9 {TkpGetFontFromAttributes: styles} {
     font actual {-weight normal} -weight
 } {normal}
-test macfont-2.8 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.10 {TkpGetFontFromAttributes: styles} {
     font actual {-weight bold} -weight
 } {bold}
-test macfont-2.9 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.11 {TkpGetFontFromAttributes: styles} {
     font actual {-slant roman} -slant
 } {roman}
-test macfont-2.10 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.12 {TkpGetFontFromAttributes: styles} {
     font actual {-slant italic} -slant
 } {italic}
-test macfont-2.11 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.13 {TkpGetFontFromAttributes: styles} {
     font actual {-underline false} -underline
 } {0}
-test macfont-2.12 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.14 {TkpGetFontFromAttributes: styles} {
     font actual {-underline true} -underline
 } {1}
-test macfont-2.13 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.15 {TkpGetFontFromAttributes: styles} {
     font actual {-overstrike false} -overstrike
 } {0}
-test macfont-2.14 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.16 {TkpGetFontFromAttributes: styles} {
     font actual {-overstrike true} -overstrike
 } {0}
 
-test macfont-3.1 {TkpDeleteFont procedure} {
+test macFont-4.1 {TkpDeleteFont} {
     font actual {-family xyz}
     set x {}
 } {}
 
-test macfont-4.1 {TkpGetFontFamilies procedure} {
-    font families
-    set x {}
-} {}
+test macFont-5.1 {TkpGetFontFamilies} {
+    expr {[lsearch [font families] Geneva] > 0}
+} {1}
+
+test macFont-6.1 {TkpGetSubFonts} {gothic} {
+    .b.l config -text "abc\u4e4e" 
+    update
+    set x [testfont subfonts $fixed]
+} "Monaco [font actual $gothic -family]"    
 
-test macfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
+test macFont-7.1 {Tk_MeasureChars: unbounded right margin} {
     .b.l config -wrap 0 -text "000000"
     getsize
 } "[expr $ax*6] $ay"
-test macfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
+test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} {
     .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
     getsize
 } "[expr $ax*256] $ay"
-test macfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
+test macFont-7.3 {Tk_MeasureChars: all chars did fit} {
     .b.l config -wrap [expr $ax*10] -text "00000000"
     getsize
 } "[expr $ax*8] $ay"
-test macfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
+test macFont-7.4 {Tk_MeasureChars: not all chars fit} {
     .b.l config -wrap [expr $ax*6] -text "00000000"
     getsize
 } "[expr $ax*6] [expr $ay*2]"
-test macfont-5.5 {Tk_MeasureChars procedure: already saw space in line} {
+test macFont-7.5 {Tk_MeasureChars: already saw space in line} {
     .b.l config -wrap [expr $ax*12] -text "000000    0000000"
     getsize
 } "[expr $ax*7] [expr $ay*2]"
-test macfont-5.6 {Tk_MeasureChars procedure: internal spaces significant} {
+test macFont-7.6 {Tk_MeasureChars: internal spaces significant} {
     .b.l config -wrap [expr $ax*12] -text "000  00   00000"
     getsize
 } "[expr $ax*7] [expr $ay*2]"
-test macfont-5.7 {Tk_MeasureChars procedure: include last partial char} {
+test macFont-7.7 {Tk_MeasureChars: include last partial char} {
     .b.c dchars $t 0 end
     .b.c insert $t 0 "0000"
     .b.c index $t @[expr int($ax*2.5)],1
 } {2}
-test macfont-5.8 {Tk_MeasureChars procedure: at least one char on line} { 
+test macFont-7.8 {Tk_MeasureChars: at least one char on line} { 
     .b.l config -text "000000" -wrap 1
     getsize
 } "$ax [expr $ay*6]"
-test macfont-5.9 {Tk_MeasureChars procedure: whole words} {
+test macFont-7.9 {Tk_MeasureChars: whole words} {
     .b.l config -wrap [expr $ax*8] -text "000000 0000"
     getsize
 } "[expr $ax*6] [expr $ay*2]"
-test macfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
+test macFont-7.10 {Tk_MeasureChars: make first part of word fit} {
     .b.l config -wrap [expr $ax*12] -text "0000000000000000"
     getsize
 } "[expr $ax*12] [expr $ay*2]"
+test macFont-7.11 {Tk_MeasureChars: numBytes == 0} {
+    font measure system {}
+} {0}
+test macFont-7.12 {Tk_MeasureChars: maxLength < 0} {
+    font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.13 {Tk_MeasureChars: loop on each char} {
+    font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.14 {Tk_MeasureChars: p == end} {
+    font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.15 {Tk_MeasureChars: p > end} {
+    font measure $courier abc\xc2
+} "[expr $cx*4]"
+test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} {
+    font measure $courier abc\u4e4edef
+} [expr $cx*6+$mx]
+test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic} {
+    font measure $courier \u4e4edef
+} [expr $mx+$cx*3]
+test macFont-7.18 {Tk_MeasureChars: final measure} {gothic} {
+    font measure $courier \u4e4edef
+} [expr $mx+$cx*3]
+test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic} {
+    font measure $courier \u4e4e
+} [expr $mx]
+test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} {
+    .b.l config -wrap [expr $ax*8] -text "000"
+    getsize
+} "[expr $ax*3] $ay"
+test macFont-7.21 {Tk_MeasureChars: loop on each char} {
+    .b.l config -wrap [expr $ax*8] -text "000"
+    getsize
+} "[expr $ax*3] $ay"
+test macFont-7.22 {Tk_MeasureChars: p == end} {
+    .b.l config -wrap [expr $ax*8] -text "000"
+    getsize
+} "[expr $ax*3] $ay"
+test macFont-7.23 {Tk_MeasureChars: p > end} {
+    .b.l config -wrap [expr $ax*8] -text "00\xc2"
+    getsize
+} "[expr $ax*3] $ay"
+test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} {
+    .b.l config -wrap [expr $ax*8] -text "00\u4e4e00"
+    getsize
+} "[expr $ax*4+$mx] $ay"
+test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic} {
+    .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
+    getsize
+} "[expr $mx+$ax*2] $ay"
+test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic} {
+    .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00"
+    getsize
+} "[expr $ax*8+$mx*2] $ay"
+test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic} {
+    .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00"
+    getsize
+} "[expr $ax*5] [expr $ay*3]"
+test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic} {
+    # even some of the "0"s would fit after \u4e4d, they should all wrap to next line.  
+    .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00"
+    getsize
+} "[expr $ax*6+$mx] [expr $ay*3]"
+test macFont-7.29 {Tk_MeasureChars: final measure} {gothic} {
+    .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
+    getsize
+} "[expr $mx+$ax*2] $ay"
+test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic} {
+    .b.l config -wrap [expr $ax*8] -text "\u4e4e"
+    getsize
+} "$mx $ay"
+test macFont-7.31 {Tk_MeasureChars: rest == NULL} {
+    .b.l config -wrap [expr $ax*1000] -text 0000
+    getsize
+} "[expr $ax*4] $ay"
+test macFont-7.32 {Tk_MeasureChars: rest != NULL} {
+    .b.l config -wrap [expr $ax*6] -text "00000000"
+    getsize
+} "[expr $ax*6] [expr $ay*2]"
 
-test macfont-6.1 {Tk_DrawChars procedure} {
+test macFont-8.1 {Tk_DrawChars procedure} {
     .b.l config -text "a"
     update
 } {}
 
-test macfont-7.1 {AllocMacFont procedure: use old font} {
+test macFont-9.1 {AllocMacFont: use old font} {
     font create xyz
     button .c -font xyz
     font configure xyz -family times
@@ -169,14 +272,31 @@ test macfont-7.1 {AllocMacFont procedure: use old font} {
     destroy .c
     font delete xyz
 } {}
-test macfont-7.2 {AllocMacFont procedure: extract info from style} {
+test macFont-9.2 {AllocMacFont: extract info from style} {
     font actual {Monaco 9 bold italic underline overstrike}
 } {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
-test macfont-7.3 {AllocMacFont procedure: extract text metrics} {
+test macFont-9.3 {AllocMacFont: extract text metrics} {
     font metric {Geneva 10} -fixed
 } {0}
-test macfont-7.4 {AllocMacFont procedure: extract text metrics} {
+test macFont-9.4 {AllocMacFont: extract text metrics} {
     font metric "Monaco 9" -fixed
 } {1}
 
 destroy .b
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/macMenu.test b/tests/macMenu.test
index 3882b0d..b76b7e6 100644
--- a/tests/macMenu.test
+++ b/tests/macMenu.test
@@ -4,13 +4,18 @@
 # system.
 #
 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: macMenu.test,v 1.2 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: macMenu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {$tcl_platform(platform) != "macintosh"} {
+    puts "skipping: Mac only tests..."
+    ::tcltest::cleanupTests
     return
 }
 
@@ -18,13 +23,10 @@ if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 proc deleteWindows {} {
     foreach i [winfo children .] {
     	catch [destroy $i]
@@ -1561,5 +1563,20 @@ test macMenu-44.2 {DrawMenuEntryBackground} {
 
 test macMenu-45.1 {TkpMenuInit - called at boot time} {} {}
 
+# cleanup
 deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
 
diff --git a/tests/macWinMenu.test b/tests/macWinMenu.test
index e19fdff..2aad508 100644
--- a/tests/macWinMenu.test
+++ b/tests/macWinMenu.test
@@ -3,26 +3,27 @@
 # the common implementation of Macintosh and Windows menus.
 #
 # Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: macWinMenu.test,v 1.2 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: macWinMenu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $
 
-if {$tcl_platform(platform) == "unix"} {
-    return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
+# Some tests require user interaction on non-unix platform
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+    [expr {$::tcltest::testConfig(userInteraction) || \
+	$::tcltest::testConfig(unixOnly)}]
 
 proc deleteWindows {} {
     foreach i [winfo children .] {
@@ -34,33 +35,26 @@ deleteWindows
 wm geometry . {}
 raise .
 
-if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
-    puts " Some tests were skipped because they could not be performed"
-    puts " automatically on this platform. If you wish to execute them"
-    puts " interactively, set the TCL variable INTERACTIVE and re-run"
-    puts " the test."
-}
-
-test macWinMenu-1.1 {PreprocessMenu} {
+test macWinMenu-1.1 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
     catch {destroy .m1}
     menu .m1 -postcommand "destroy .m1"
     .m1 add command -label "macWinMenu-1.1: Hit Escape"
     list [catch {.m1 post 40 40} msg] $msg
 } {0 {}}
-if {$tcl_platform(platform) != "windows" || [info exists INTERACTIVE]} {
-    test macWinMenu-1.2 {PreprocessMenu} {
-	catch {destroy .m1}
-	catch {destroy .m2}
-	set foo1 foo
-	set foo2 foo
-	menu .m1 -postcommand "set foo1 .m1"
-	.m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape"
-	menu .m2 -postcommand "set foo2 .m2"
-	update idletasks
-	list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}]
-    } {0 .m2 .m1 .m2 {} 0 0}
-}
-test macWinMenu-1.3 {PreprocessMenu} {
+test macWinMenu-1.2 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
+    catch {destroy .m1}
+    catch {destroy .m2}
+    set foo1 foo
+    set foo2 foo
+    menu .m1 -postcommand "set foo1 .m1"
+    .m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape"
+    menu .m2 -postcommand "set foo2 .m2"
+    update idletasks
+    list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] \
+	    [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}]
+} {0 .m2 .m1 .m2 {} 0 0}
+
+test macWinMenu-1.3 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
     catch {destroy .l1}
     catch {destroy .m1}
     catch {destroy .m2}
@@ -76,7 +70,7 @@ test macWinMenu-1.3 {PreprocessMenu} {
     update idletasks
     list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3]
 } {0 {} {}}
-test macWinMenu-1.4 {PreprocessMenu} {
+test macWinMenu-1.4 {PreprocessMenu} {macOrPc} {
     catch {destroy .l1}
     catch {destroy .m1}
     catch {destroy .m2}
@@ -95,7 +89,7 @@ test macWinMenu-1.4 {PreprocessMenu} {
     update idletasks
     list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3 .m4]
 } {0 {} {}}
-test macWinMenu-1.5 {PreprocessMenu} {
+test macWinMenu-1.5 {PreprocessMenu} {macOrPc} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -104,14 +98,28 @@ test macWinMenu-1.5 {PreprocessMenu} {
     list [catch {.m1 post 40 40} msg] $msg [destroy .m1 .m2]
 } {1 {invalid command name "glorp"} {}}
 
-if {$tcl_platform(platform) != "windows" || [info exists INTERACTIVE]} {
-    test macWinMenu-2.1 {TkPreprocessMenu} {
-	catch {destroy .m1}
-	set foo test
-	menu .m1 -postcommand "set foo 2.1"
-	.m1 add command -label "macWinMenu-2.1: Hit Escape"
-	list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo]
-    } {0 2.1 2.1 {} {}}
-}
+test macWinMenu-2.1 {TkPreprocessMenu} {macOrPc nonUnixUserInteraction} {
+    catch {destroy .m1}
+    set foo test
+    menu .m1 -postcommand "set foo 2.1"
+    .m1 add command -label "macWinMenu-2.1: Hit Escape"
+    list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo]
+} {0 2.1 2.1 {} {}}
 
+# cleanup
 deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/macscrollbar.test b/tests/macscrollbar.test
index c13198a..4abf137 100644
--- a/tests/macscrollbar.test
+++ b/tests/macscrollbar.test
@@ -4,17 +4,20 @@
 # Tcl tests.
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: macscrollbar.test,v 1.2 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: macscrollbar.test,v 1.3 1999/04/16 01:51:39 stanton Exp $
 
-# Only run this test on the Macintosh
-if {$tcl_platform(platform) != "macintosh"} return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
-if {[info procs test] != "test"} {
-    source defs
+# Only run this test on the Macintosh
+if {$tcl_platform(platform) != "macintosh"} {
+    puts "skipping: Mac only tests..."
+    ::tcltest::cleanupTests
+    return
 }
 
 foreach i [winfo children .] {
@@ -98,4 +101,20 @@ test macscroll-1.7 {TkpDisplayScrollbar procedure} {
 foreach i [winfo children .] {
     destroy $i
 }
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/main.test b/tests/main.test
index 5db6ed5..0422223 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -5,14 +5,13 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: main.test,v 1.4 1999/02/04 21:03:28 stanton Exp $
+# RCS: @(#) $Id: main.test,v 1.5 1999/04/16 01:51:39 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 test main-1.1 {StdinProc} {unixOnly} {
@@ -22,7 +21,7 @@ test main-1.1 {StdinProc} {unixOnly} {
 	close stdin; exit
     }
     close $fd
-    if {[catch {exec $tktest <script} msg]} {
+    if {[catch {exec $::tcltest::tktest <script} msg]} {
 	set error 1
     } else {
 	set error 0
@@ -31,7 +30,20 @@ test main-1.1 {StdinProc} {unixOnly} {
     list $error $msg
 } {0 {}}
 
-#
-# Clean up.
-#
+# cleanup
 catch {removeFile script}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/menu.test b/tests/menu.test
index a4399b5..7b8ba02 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -2,32 +2,27 @@
 # organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: menu.test,v 1.2 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: menu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
-if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
-    puts " Some tests were skipped because they could not be performed"
-    puts " automatically on this platform. If you wish to execute them"
-    puts " interactively, set the TCL variable INTERACTIVE and re-run"
-    puts " the test."
-    set testConfig(menuInteractive) 0
-} else {
-    set testConfig(menuInteractive) 1
-}
+# Some tests require user interaction on non-unix platform
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+    [expr {$::tcltest::testConfig(userInteraction) || \
+	$::tcltest::testConfig(unixOnly)}]
 
 proc deleteWindows {} {
     foreach i [winfo children .] {
@@ -164,16 +159,16 @@ test menu-1.14 {Tk_MenuCmd procedure} {
 catch {destroy .m1}
 menu .m1
 set i 1
-foreach test {
+foreach configTest {
     {-activebackground #012345 #012345 non-existent
 	    {unknown color name "non-existent"}}
-    {-activeborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+    {-activeborderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
     {-activeforeground #ff0000 #ff0000 non-existent
 	    {unknown color name "non-existent"}}
     {-background #ff0000 #ff0000 non-existent
 	    {unknown color name "non-existent"}}
     {-bg #110022 #110022 bogus {unknown color name "bogus"}}
-    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+    {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
     {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
@@ -182,23 +177,27 @@ foreach test {
 	    {font "" doesn't exist}}
     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
     {-postcommand "any old string" "any old string" {} {}}
-    {-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 "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
     {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
     {-takefocus "any string" "any string" {} {}}
     {-tearoff 0 0}
     {-tearoff 1 1}
     {-tearoffcommand "any old string" "any old string" {} {}}
 } {
-    set name [lindex $test 0]
-    test menu-2.$i {configuration options} {
-	.m1 configure $name [lindex $test 1]
+    set name [lindex $configTest 0]
+    set value [lindex $configTest 1]
+    set result [lindex $configTest 2]
+    test menu-2.$i [list configuration options $name $value $result] {
+	.m1 configure $name $value
 	lindex [.m1 configure $name] 4
-    } [lindex $test 2]
+    } $result
     incr i
-    if {[lindex $test 3] != ""} {
-	test menu-2.$i {configuration options} {
-	    list [catch {.m1 configure $name [lindex $test 3]} msg] $msg
-	} [list 1 [lindex $test 4]]
+    if {[lindex $configTest 3] != ""} {
+	set value [lindex $configTest 3]
+	set result [lindex $configTest 4]
+	test menu-2.$i [list configuration options $name $value $result] {
+	    list [catch {.m1 configure $name $value} msg] $msg
+	} [list 1 $result]
     }
     .m1 configure $name [lindex [.m1 configure $name] 3]
     incr i
@@ -221,7 +220,7 @@ menu .m2
 .m1 add radiobutton -label "radiobutton" -variable radio
 image create photo image1 -file [file join $tk_library demos images earth.gif]
 
-foreach test {
+foreach configTest {
     {-activebackground 
         {{#012345 
             {{unknown option "-activebackground"} #012345 #012345 
@@ -240,7 +239,7 @@ foreach test {
     }
     {-activeforeground
     	{{#ff0000 
-    	    {{unknown option "-activeforeground"}
+	    {{unknown option "-activeforeground"}
 	    #ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
 	    }
 	}
@@ -256,7 +255,7 @@ foreach test {
     }
     {-accelerator
     	{{"Ctrl+S" 
-    	    {{unknown option "-accelerator"}
+	    {{unknown option "-accelerator"}
 	    "Ctrl+S" "Ctrl+S" {unknown option "-accelerator"} 
 	    "Ctrl+S" "Ctrl+S"
 	    }
@@ -279,8 +278,8 @@ foreach test {
     }
     {-bitmap
     	{{questhead 
-    	    {{unknown option "-bitmap"} questhead questhead 
-    	    {unknown option "-bitmap"} questhead questhead
+	    {{unknown option "-bitmap"} questhead questhead 
+	    {unknown option "-bitmap"} questhead questhead
 	    }
 	}
 	{badValue
@@ -295,22 +294,23 @@ foreach test {
     }
     {-columnbreak
 	{{1
-	    {{unknown option "-columnbreak"} 1 1 {unknown option "-columnbreak"} 1 1}
+	    {{unknown option "-columnbreak"} 1 1 
+	    {unknown option "-columnbreak"} 1 1}
 	}}
     }
     {-command
     	{{beep 
-    	    {{unknown option "-command"} beep beep 
-    	    {unknown option "-command"} beep beep
+	    {{unknown option "-command"} beep beep 
+	    {unknown option "-command"} beep beep
 	    }
 	}}
     }
     {-font
     	{{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
-    	    {{unknown option "-font"}
+	    {{unknown option "-font"}
     	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
     	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
-    	    {unknown option "-font"} 
+	    {unknown option "-font"} 
     	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
     	    -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
 	    }
@@ -327,8 +327,8 @@ foreach test {
     }
     {-foreground
     	{{#110022 
-    	    {{unknown option "-foreground"} #110022 #110022 
-    	    {unknown option "-foreground"} #110022 #110022
+	    {{unknown option "-foreground"} #110022 #110022 
+	    {unknown option "-foreground"} #110022 #110022
 	    }
 	}
 	{non-existent
@@ -343,8 +343,8 @@ foreach test {
     }
     {-image
     	{{image1 
-    	    {{unknown option "-image"} image1 image1 
-    	    {unknown option "-image"} image1 image1
+	    {{unknown option "-image"} image1 image1 
+	    {unknown option "-image"} image1 image1
 	    }
 	}
 	{bogus
@@ -368,58 +368,58 @@ foreach test {
     }
     {-indicatoron
     	{{1 
-    	    {{unknown option "-indicatoron"}
-    	    {unknown option "-indicatoron"}
-    	    {unknown option "-indicatoron"} 
-    	    {unknown option "-indicatoron"} 1 1
+	    {{unknown option "-indicatoron"}
+	    {unknown option "-indicatoron"}
+	    {unknown option "-indicatoron"} 
+	    {unknown option "-indicatoron"} 1 1
 	    }
 	}}
     }
     {-label
     	{{test 
-    	    {{unknown option "-label"} test test 
-    	    {unknown option "-label"} test test
+	    {{unknown option "-label"} test test 
+	    {unknown option "-label"} test test
 	    }
 	}}
     }
     {-menu
     	{{.m2 
-    	    {{unknown option "-menu"}
-    	    {unknown option "-menu"} .m2 
-    	    {unknown option "-menu"}
-    	    {unknown option "-menu"}
-    	    {unknown option "-menu"}
+	    {{unknown option "-menu"}
+	    {unknown option "-menu"} .m2 
+	    {unknown option "-menu"}
+	    {unknown option "-menu"}
+	    {unknown option "-menu"}
 	    }
 	}}
     }
     {-offvalue
     	{{off
-    	    {{unknown option "-offvalue"} 
-    	    {unknown option "-offvalue"}
+	    {{unknown option "-offvalue"} 
+	    {unknown option "-offvalue"}
+	    {unknown option "-offvalue"}
 	    {unknown option "-offvalue"}
-    	    {unknown option "-offvalue"}
     	    off
-    	    {unknown option "-offvalue"}
+	    {unknown option "-offvalue"}
 	    }
 	}}
     }
     {-onvalue
     	{{on
-    	    {{unknown option "-onvalue"}
-    	    {unknown option "-onvalue"}
-    	    {unknown option "-onvalue"}
-    	    {unknown option "-onvalue"}
+	    {{unknown option "-onvalue"}
+	    {unknown option "-onvalue"}
+	    {unknown option "-onvalue"}
+	    {unknown option "-onvalue"}
     	    on 
-      	    {unknown option "-onvalue"}
+	    {unknown option "-onvalue"}
 	    }
 	}}
     }
     {-selectcolor
     	{{#110022 
-    	    {{unknown option "-selectcolor"} 
-    	    {unknown option "-selectcolor"}
-    	    {unknown option "-selectcolor"} 
-    	    {unknown option "-selectcolor"}
+	    {{unknown option "-selectcolor"} 
+	    {unknown option "-selectcolor"}
+	    {unknown option "-selectcolor"} 
+	    {unknown option "-selectcolor"}
     	    #110022
     	    #110022
 	    }
@@ -463,8 +463,7 @@ foreach test {
     }
     {-state
     	{{normal 
-    	    {normal normal normal 
-    	    {unknown option "-state"} normal normal
+    	    {normal normal normal {unknown option "-state"} normal normal
 	    }
 	}}
     }
@@ -506,13 +505,13 @@ foreach test {
 	}}
     }
 } {
-    set name [lindex $test 0]
-    foreach attempt [lindex $test 1] {
+    set name [lindex $configTest 0]
+    foreach attempt [lindex $configTest 1] {
     	set value [lindex $attempt 0]
     	set options [lindex $attempt 1]
     	foreach item {0 1 2 3 4 5} {
     	    catch {unset msg}
-    	    test menu-2.$i [list entry configuration options $name $item $value] {
+    	    test menu-2.$i [list entry configuration options $name $item $value [.m1 type $item]] {
             	set result [catch {.m1 entryconfigure $item $name $value} msg]
                 if {$result == 1} {
             	    set msg
@@ -534,7 +533,7 @@ test menu-3.1 {MenuWidgetCmd procedure} {
     menu .m1
     list [catch {.m1} msg] $msg [destroy .m1]
 } {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
-test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {menuInteractive} {
+test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {nonUnixUserInteraction } {
     catch {destroy .m1}
     menu .m1 -postcommand "destroy .m1"
     .m1 add command -label "menu-3.2: Hit Escape"
@@ -551,21 +550,21 @@ test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
     menu .m1
     list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
 } {1 {bad menu entry index "foo"} {}}
-test menu-3.5 {MenuWidgetCmd procedure, "activate" option}  {
+test menu-3.5 {MenuWidgetCmd procedure, "activate" option} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     .m1 add separator
     list [catch {.m1 activate 2} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-3.6 {MenuWidgetCmd procedure, "activate" option}  {
+test menu-3.6 {MenuWidgetCmd procedure, "activate" option} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     .m1 entryconfigure 1 -state disabled
     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-3.7 {MenuWidgetCmd procedure, "activate" option}  {
+test menu-3.7 {MenuWidgetCmd procedure, "activate" option} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
@@ -805,7 +804,7 @@ test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
     menu .m1
     list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
 } {1 {expected integer but got "bar"} {}}
-test menu-3.50 {MenuWidgetCmd procedure, "post" option} {menuInteractive} {
+test menu-3.50 {MenuWidgetCmd procedure, "post" option} {nonUnixUserInteraction } {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
@@ -821,7 +820,7 @@ test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
     menu .m1
     list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
 } {1 {bad menu entry index "foo"} {}}
-test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {menuInteractive} {
+test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -890,7 +889,7 @@ test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
     menu .m1
     list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
 } {1 {wrong # args: should be ".m1 unpost"} {}}
-test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {menuInteractive} {
+test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {nonUnixUserInteraction } {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "menu-3.68 - hit Escape"
@@ -913,19 +912,27 @@ test menu-3.67 {MenuWidgetCmd procedure, bad option} {
     list [catch {.m1 foo} msg] $msg [destroy .m1]
 } {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}
 
-test menu-4.1 {TkInvokeMenu} {
+test menu-4.1 {TkInvokeMenu: disabled} {
+    catch {destroy .m1}
+    catch {unset foo}
+    menu .m1
+    .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off \
+	-state disabled
+    list [catch {.m1 invoke 1} msg] [destroy .m1] $foo
+} {0 {} off}
+test menu-4.2 {TkInvokeMenu: tearoff} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 invoke 0} msg] [destroy .m1]
 } {0 {}}
-test menu-4.2 {TkInvokeMenu} {
+test menu-4.3 {TkInvokeMenu: checkbutton -on} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
     .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 } {0 {} 0 on 0 {} {}}
-test menu-4.3 {TkInvokeMenu} {
+test menu-4.4 {TkInvokeMenu: checkbutton -off} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
@@ -933,7 +940,14 @@ test menu-4.3 {TkInvokeMenu} {
     .m1 invoke 1
     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 } {0 {} 0 off 0 {} {}}
-test menu-4.4 {TkInvokeMenu} {
+test menu-4.5 {TkInvokeMenu: checkbutton array element} {
+    catch {destroy .m1}
+    catch {unset foo}
+    menu .m1
+    .m1 add checkbutton -label "test" -variable foo(1) -onvalue on 
+    list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 on 0 {} {}}
+test menu-4.6 {TkInvokeMenu: radiobutton} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
@@ -942,7 +956,7 @@ test menu-4.4 {TkInvokeMenu} {
     .m1 add radiobutton -label "3" -variable foo -value three
     list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 } {0 {} 0 one 0 {} {}}
-test menu-4.5 {TkInvokeMenu} {
+test menu-4.7 {TkInvokeMenu: radiobutton} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
@@ -951,7 +965,7 @@ test menu-4.5 {TkInvokeMenu} {
     .m1 add radiobutton -label "3" -variable foo -value three
     list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 } {0 {} 0 two 0 {} {}}
-test menu-4.6 {TkInvokeMenu} {
+test menu-4.8 {TkInvokeMenu: radiobutton} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
@@ -960,20 +974,29 @@ test menu-4.6 {TkInvokeMenu} {
     .m1 add radiobutton -label "3" -variable foo -value three
     list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
 } {0 {} 0 three 0 {} {}}
-test menu-4.7 {TkInvokeMenu} {
+test menu-4.9 {TkInvokeMenu: radiobutton array element} {
+    catch {destroy .m1}
+    catch {unset foo}
+    menu .m1
+    .m1 add radiobutton -label "1" -variable foo(2) -value one
+    .m1 add radiobutton -label "2" -variable foo(2) -value two
+    .m1 add radiobutton -label "3" -variable foo(2) -value three
+    list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 three 0 {} {}}
+test menu-4.10 {TkInvokeMenu} {
     catch {destroy .m1}
     catch {unset menu_test}
     menu .m1
     .m1 add command -label "test" -command "set menu_test menu-4.8"
     list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
 } {0 menu-4.8 0 menu-4.8 0 {} {}}
-test menu-4.8 {TkInvokeMenu} {
+test menu-4.11 {TkInvokeMenu} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -label "test" -menu .m1.m2
     list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-4.9 {TkInvokeMenu} {
+test menu-4.12 {TkInvokeMenu} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test" -command ".m1 delete 1"
@@ -1431,44 +1454,60 @@ test menu-9.9 {ConfigureMenu} {
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
 
-test menu-10.1 {ConfigureMenuEntry} {
+test menu-10.1 {PostProcessEntry: array variable} {
+    catch {destroy .m1}
+    catch {unset foo}
+    menu .m1
+    set foo(1) on
+    .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
+    list [catch {set foo(1)} msg] $msg [destroy .m1]
+} {0 on {}}
+test menu-10.2 {PostProcessEntry: array variable} {
+    catch {destroy .m1}
+    catch {unset foo}
+    menu .m1
+    .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
+    list [catch {set foo(1)} msg] $msg [destroy .m1]
+} {0 off {}}
+
+test menu-11.1 {ConfigureMenuEntry} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
     .m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
     list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
 } {0 {} bar {}}
-test menu-10.2 {ConfigureMenuEntry} {
+test menu-11.2 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
 } {0 {} {} {}}
-test menu-10.3 {ConfigureMenuEntry} {
+test menu-11.3 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command
     list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
 } {0 {} test {}}
-test menu-10.4 {ConfigureMenuEntry} {
+test menu-11.4 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1 
     .m1 add command
     list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
 } {0 {} S {}}
-test menu-10.5 {ConfigureMenuEntry} {
+test menu-11.5 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command
     list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
 } {0 {} test {}}
-test menu-10.6 {ConfigureMenuEntry} {
+test menu-11.6 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command
     list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-10.7 {ConfigureMenuEntry} {
+test menu-11.7 {ConfigureMenuEntry} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m2
@@ -1476,31 +1515,31 @@ test menu-10.7 {ConfigureMenuEntry} {
     .m1 add cascade
     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
 } {0 {} {}}
-test menu-10.8 {ConfigureMenuEntry} {
+test menu-11.8 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade
     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-10.9 {ConfigureMenuEntry} {
+test menu-11.9 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -menu .m3
     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-10.10 {ConfigureMenuEntry} {
+test menu-11.10 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade
     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-10.11 {ConfigureMenuEntry} {
+test menu-11.11 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -menu .m2
     list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-10.12 {ConfigureMenuEntry} {
+test menu-11.12 {ConfigureMenuEntry} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -1517,7 +1556,7 @@ test menu-10.12 {ConfigureMenuEntry} {
     .m5 add cascade
     list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
 } {0 {} {}}
-test menu-10.13 {ConfigureMenuEntry} {
+test menu-11.13 {ConfigureMenuEntry} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -1531,29 +1570,29 @@ test menu-10.13 {ConfigureMenuEntry} {
     .m4 add cascade -menu .m1
     list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
 } {0 {} {}}
-test menu-10.14 {ConfigureMenuEntry} {
+test menu-11.14 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton
     list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
 } {0 {} test {}}
-test menu-10.15 {ConfigureMenuEntry} {
+test menu-11.15 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
 } {0 {} test {}}
-test menu-10.16 {ConfigureMenuEntry} {
+test menu-11.16 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-10.17 {ConfigureMenuEntry} {
+test menu-11.17 {ConfigureMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton
     list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
 } {0 {} test {}}
-test menu-10.18 {ConfigureMenuEntry} {
+test menu-11.18 {ConfigureMenuEntry} {
     catch {destroy .m1}
     catch {image delete image1}
     menu .m1
@@ -1561,7 +1600,7 @@ test menu-10.18 {ConfigureMenuEntry} {
     image create test image1
     list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
 } {0 {} {} {}}
-test menu-10.19 {ConfigureMenuEntry} {
+test menu-11.19 {ConfigureMenuEntry} {
     catch {destroy .m1}
     catch {image delete image1}
     catch {image delete image2}
@@ -1571,7 +1610,7 @@ test menu-10.19 {ConfigureMenuEntry} {
     .m1 add command -image image1
     list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
 } {0 {} {} {} {}}
-test menu-10.20 {ConfigureMenuEntry} {
+test menu-11.20 {ConfigureMenuEntry} {
     catch {destroy .m1}
     catch {image delete image1}
     catch {image delete image2}
@@ -1581,7 +1620,7 @@ test menu-10.20 {ConfigureMenuEntry} {
     .m1 add checkbutton -image image1
     list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
 } {0 {} {} {} {}}
-test menu-10.21 {ConfigureMenuEntry} {
+test menu-11.21 {ConfigureMenuEntry} {
     catch {destroy .m1}
     catch {image delete image1}
     catch {image delete image2}
@@ -1594,7 +1633,7 @@ test menu-10.21 {ConfigureMenuEntry} {
     list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
 } {0 {} {} {} {} {}}
 
-test menu-11.1 {ConfigureMenuCloneEntries} {
+test menu-12.1 {ConfigureMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -1606,7 +1645,7 @@ test menu-11.1 {ConfigureMenuCloneEntries} {
     .m1 add command -label "test2"
     list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
 } {{1 {unknown option "-gork"}} {}}
-test menu-11.2 {ConfigureMenuCloneEntries} {
+test menu-12.2 {ConfigureMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -1618,7 +1657,7 @@ test menu-11.2 {ConfigureMenuCloneEntries} {
     menu .m4
     list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
 } {0 {} {} {} {}}
-test menu-11.3 {ConfigureMenuCloneEntries} {
+test menu-12.3 {ConfigureMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -1627,7 +1666,18 @@ test menu-11.3 {ConfigureMenuCloneEntries} {
     list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test menu-12.1 {TkGetMenuIndex} {
+test menu-12.4 {ConfigureMenuCloneEntries} {
+     catch {destroy .m1}
+     catch {destroy .m2}
+     menu .m1
+     .m1 add cascade -label File -menu .m1.foo
+     menu .m1.foo
+     .m1.foo add command -label bar
+     .m1 clone .m2
+     list [catch {.m1 entryconfigure File -state disabled} msg1] $msg1 [destroy .m1]
+} {0 {} {}}
+
+test menu-13.1 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "active"
@@ -1636,7 +1686,7 @@ test menu-12.1 {TkGetMenuIndex} {
     .m1 activate 2
     list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
 } {0 test2 {}}
-test menu-12.2 {TkGetMenuIndex} {
+test menu-13.2 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "last"
@@ -1645,7 +1695,7 @@ test menu-12.2 {TkGetMenuIndex} {
     .m1 activate 2
     list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
 } {0 test3 {}}
-test menu-12.3 {TkGetMenuIndex} {
+test menu-13.3 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "last"
@@ -1654,19 +1704,19 @@ test menu-12.3 {TkGetMenuIndex} {
     .m1 activate 2
     list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
 } {0 test3 {}}
-test menu-12.4 {TkGetMenuIndex} {
+test menu-13.4 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
 } {0 {} test2 {}}
-test menu-12.5 {TkGetMenuIndex} {
+test menu-13.5 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
 } {0 {} test2 {}}
-test menu-12.6 {TkGetMenuIndex} {
+test menu-13.6 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "active"
@@ -1676,7 +1726,7 @@ test menu-12.6 {TkGetMenuIndex} {
     list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
 } {0 {} {}}
 #test menu-13.7 - Need to add @test here.
-test menu-12.7 {TkGetMenuIndex} {
+test menu-13.7 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "active"
@@ -1684,32 +1734,32 @@ test menu-12.7 {TkGetMenuIndex} {
     .m1 add command -label "test3"
     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
 } {0 active {}}
-test menu-12.8 {TkGetMenuIndex} {
+test menu-13.8 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "active"
     list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
 } {1 {bad menu entry index "-1"} {}}
-test menu-12.9 {TkGetMenuIndex} {
+test menu-13.9 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     .m1 add command -label "test2"
     list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
 } {0 test2 {}}
-test menu-12.10 {TkGetMenuIndex} {
+test menu-13.10 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 insert 999 command -label "test"
     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
 } {0 test {}}
-test menu-12.11 {TkGetMenuIndex} {
+test menu-13.11 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "1test"
     list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
 } {0 1test {}}
-test menu-12.12 {TkGetMenuIndex} {
+test menu-13.12 {TkGetMenuIndex} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
@@ -1718,101 +1768,101 @@ test menu-12.12 {TkGetMenuIndex} {
     list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
 } {0 beep {}}
 
-test menu-13.1 {MenuCmdDeletedProc} {
+test menu-14.1 {MenuCmdDeletedProc} {
     catch {destroy .m1}
     menu .m1
     list [catch {destroy .m1} msg] $msg
 } {0 {}}
-test menu-13.2 {MenuCmdDeletedProc} {
+test menu-14.2 {MenuCmdDeletedProc} {
     catch {destroy .m1}
     menu .m1
     .m1 clone .m2
     list [catch {destroy .m1} msg] $msg
 } {0 {}}
 
-test menu-14.1 {MenuNewEntry} {
+test menu-15.1 {MenuNewEntry} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-14.2 {MenuNewEntry} {
+test menu-15.2 {MenuNewEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     .m1 add command -label "test3"
     list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-14.3 {MenuNewEntry} {
+test menu-15.3 {MenuNewEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-14.4 {MenuNewEntry} {
+test menu-15.4 {MenuNewEntry} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test menu-15.1 {MenuAddOrInsert} {
+test menu-16.1 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
 } {1 {bad menu entry index "foo"} {}}
-test menu-15.2 {MenuAddOrInsert} {
+test menu-16.2 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-15.3 {MenuAddOrInsert} {
+test menu-16.3 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
 } {1 {bad menu entry index "-1"} {}}
-test menu-15.4 {MenuAddOrInsert} {
+test menu-16.4 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     .m1 insert 0 command -label "test2"
     list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
 } {0 test2 {}}
-test menu-15.5 {MenuAddOrInsert} {
+test menu-16.5 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add cascade} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-15.6 {MenuAddOrInsert} {
+test menu-16.6 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-15.7 {MenuAddOrInsert} {
+test menu-16.7 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-15.8 {MenuAddOrInsert} {
+test menu-16.8 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-15.9 {MenuAddOrInsert} {
+test menu-16.9 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add separator} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-15.10 {MenuAddOrInsert} {
+test menu-16.10 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add blork} msg] $msg [destroy .m1]
 } {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
-test menu-15.11 {MenuAddOrInsert} {
+test menu-16.11 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-15.12 {MenuAddOrInsert} {
+test menu-16.12 {MenuAddOrInsert} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -1821,7 +1871,7 @@ test menu-15.12 {MenuAddOrInsert} {
     .m2 clone .m3
     list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
 } {0 {} 0 test 0 test {}}
-test menu-15.13 {MenuAddOrInsert} {
+test menu-16.13 {MenuAddOrInsert} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -1830,12 +1880,12 @@ test menu-15.13 {MenuAddOrInsert} {
     .m2 clone .m3
     list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
 } {0 {} 0 test 0 test {}}
-test menu-15.14 {MenuAddOrInsert} {
+test menu-16.14 {MenuAddOrInsert} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
 } {1 {unknown option "-blork"} {}}
-test menu-15.15 {MenuAddOrInsert} {
+test menu-16.15 {MenuAddOrInsert} {
     catch {destroy .m1}
     catch {destroy .container}
     menu .m1
@@ -1844,7 +1894,7 @@ test menu-15.15 {MenuAddOrInsert} {
     . configure -menu .container
     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
 } {0 {} {} {}}
-test menu-15.16 {MenuAddOrInsert} {
+test menu-16.16 {MenuAddOrInsert} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -1852,7 +1902,7 @@ test menu-15.16 {MenuAddOrInsert} {
     set tearoff [tkTearOffMenu .m2]
     list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
 } {0 {} {} 0 {} 0 {}}
-test menu-15.17 {MenuAddOrInsert} {
+test menu-16.17 {MenuAddOrInsert} {
     catch {destroy .m1}
     catch {destroy .container}
     menu .m1
@@ -1861,7 +1911,7 @@ test menu-15.17 {MenuAddOrInsert} {
     set tearoff [tkTearOffMenu .container]
     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
 } {0 {} {} {}}
-test menu-15.18 {MenuAddOrInsert} {
+test menu-16.18 {MenuAddOrInsert} {
     catch {destroy .m1}
     catch {destroy .container}
     menu .m1
@@ -1870,7 +1920,7 @@ test menu-15.18 {MenuAddOrInsert} {
     . configure -menu .container
     list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
 } {0 {} {} {}}
-test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
+test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
     catch {destroy .menubar}
     menu .menubar
     menu .menubar.test -tearoff 0
@@ -1884,7 +1934,7 @@ test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
 	[. configure -menu ""] [destroy .menubar]
 } {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}
 
-test menu-16.1 {MenuVarProc} {
+test menu-17.1 {MenuVarProc} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
@@ -1892,45 +1942,45 @@ test menu-16.1 {MenuVarProc} {
     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
 } {0 {} 0 {} {}}
 # menu-17.2 - Don't know how to generate the flags in the if
-test menu-16.2 {MenuVarProc} {
+test menu-17.2 {MenuVarProc} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
 } {0 {} {} {}}
-test menu-16.3 {MenuVarProc} {
+test menu-17.3 {MenuVarProc} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
     set foo "hello"
     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
 } {0 {} hello {} 0 {}}
-test menu-16.4 {MenuVarProc} {
+test menu-17.4 {MenuVarProc} {
     catch {destroy .m1}
     menu .m1
     set foo "goodbye"
     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
 } {0 {} hello {} 0 {}}
-test menu-16.5 {MenuVarProc} {
+test menu-17.5 {MenuVarProc} {
     catch {destroy .m1}
     menu .m1
     set foo "hello"
     list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
 } {0 {} goodbye {} 0 {}}
 
-test menu-17.1 {TkActivateMenuEntry} {
+test menu-18.1 {TkActivateMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-17.2 {TkActivateMenuEntry} {
+test menu-18.2 {TkActivateMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     list [catch {.m1 activate 0} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-17.3 {TkActivateMenuEntry} {
+test menu-18.3 {TkActivateMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
@@ -1938,7 +1988,7 @@ test menu-17.3 {TkActivateMenuEntry} {
     .m1 activate 1
     list [catch {.m1 activate 2} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-17.4 {TkActivateMenuEntry} {
+test menu-18.4 {TkActivateMenuEntry} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
@@ -1947,56 +1997,56 @@ test menu-17.4 {TkActivateMenuEntry} {
     list [catch {.m1 activate 1} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test menu-18.1 {TkPostCommand} {menuInteractive} {
+test menu-19.1 {TkPostCommand} {nonUnixUserInteraction } {
     catch {destroy .m1}
     menu .m1 -postcommand "set menu_test menu-19.1"
     .m1 add command -label "menu-19.1 - hit Escape"
     list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
 } {0 menu-19.1 {} menu-19.1 {}}
-test menu-18.2 {TkPostCommand} {menuInteractive} {
+test menu-19.2 {TkPostCommand} {nonUnixUserInteraction } {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "menu-19.2 - hit Escape"
     list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
 } {0 {} {} {}}
 
-test menu-19.1 {CloneMenu} {
+test menu-20.1 {CloneMenu} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
     list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
 } {0 {} {}}
-test menu-19.2 {CloneMenu} {
+test menu-20.2 {CloneMenu} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
     list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
 } {0 {} {}}
-test menu-19.3 {CloneMenu} {
+test menu-20.3 {CloneMenu} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
     list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
 } {0 {} {}}
-test menu-19.4 {CloneMenu} {
+test menu-20.4 {CloneMenu} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
     list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
 } {0 {} {}}
-test menu-19.5 {CloneMenu} {
+test menu-20.5 {CloneMenu} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
     list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
-} {1 {bad menu type - must be normal, tearoff, or menubar} {}}
-test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
+} {1 {bad menu type "foo": must be normal, tearoff, or menubar} {}}
+test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
     list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
  } {0 {} {}}
- test menu-19.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
+ test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -2004,14 +2054,14 @@ test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
     .m1 clone .m2
     list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
  } {0 {} {}}
- test menu-19.8 {CloneMenu - cascade entries} {
+ 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-19.9 {CloneMenu - cascades entries} {
+ test menu-20.9 {CloneMenu - cascades entries} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .foo}
@@ -2020,13 +2070,13 @@ test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
     menu .m2
     list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
  } {0 {} {}}
-test menu-19.10 {CloneMenu - tearoff fields} {
+test menu-20.10 {CloneMenu - tearoff fields} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
     list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
 } {0 {} 0 1 {}}
-test menu-19.11 {CloneMenu} {
+test menu-20.11 {CloneMenu} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -2034,26 +2084,26 @@ test menu-19.11 {CloneMenu} {
     list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
 } {1 {window name "m2" already exists in parent} {}}
 
-test menu-20.1 {MenuDoYPosition} {
+test menu-21.1 {MenuDoYPosition} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
 } {1 {bad menu entry index "glorp"} {}}
-test menu-20.2 {MenuDoYPosition} {
+test menu-21.2 {MenuDoYPosition} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "Test"
     list [catch {.m1 yposition 1}] [destroy .m1]
 } {0 {}}
 
-test menu-21.1 {GetIndexFromCoords} {
+test menu-22.1 {GetIndexFromCoords} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     .m1 configure -tearoff 0
     list [catch {.m1 index @5} msg] $msg [destroy .m1]
 } {0 0 {}}
-test menu-21.2 {GetIndexFromCoords} {
+test menu-22.2 {GetIndexFromCoords} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
@@ -2061,13 +2111,13 @@ test menu-21.2 {GetIndexFromCoords} {
     list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
 } {0 0 {}}
 
-test menu-22.1 {RecursivelyDeleteMenu} {
+test menu-23.1 {RecursivelyDeleteMenu} {
     catch {destroy .m1}
     menu .m1
     . configure -menu .m1
     list [catch {. configure -menu ""} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-22.2 {RecursivelyDeleteMenu} {
+test menu-23.2 {RecursivelyDeleteMenu} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m2
@@ -2078,40 +2128,40 @@ test menu-22.2 {RecursivelyDeleteMenu} {
     list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
 } {0 {} {}}
 
-test menu-23.1 {TkNewMenuName} {
+test menu-24.1 {TkNewMenuName} {
     catch {destroy .m1}
     menu .m1
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test menu-23.2 {TkNewMenuName} {
+test menu-24.2 {TkNewMenuName} {
     catch {destroy .m1}
     catch {destroy .m1\#0}
     menu .m1
     menu .m1\#0
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test menu-23.3 {TkNewMenuName} {
+test menu-24.3 {TkNewMenuName} {
     catch {destroy .#m}
     menu .#m
     rename .#m hideme
     list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
 } {0 {} {} {} {}}
 
-test menu-24.1 {TkSetWindowMenuBar} {
+test menu-25.1 {TkSetWindowMenuBar} {
     . configure -menu ""
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
 } {0 {} {}}
-test menu-24.2 {TkSetWindowMenuBar} {
+test menu-25.2 {TkSetWindowMenuBar} {
     . configure -menu ""
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
 } {0 {} {}}
-test menu-24.3 {TkSetWindowMenuBar} {
+test menu-25.3 {TkSetWindowMenuBar} {
     . configure -menu ""
     catch {destroy .m1}
     menu .m1
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test menu-24.4 {TkSetWindowMenuBar} {
+test menu-25.4 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     catch {destroy .m2}
     . configure -menu ""
@@ -2120,7 +2170,7 @@ test menu-24.4 {TkSetWindowMenuBar} {
     menu .m2
     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
 } {0 {} {} {}}
-test menu-24.5 {TkSetWindowMenuBar} {
+test menu-25.5 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -2131,7 +2181,7 @@ test menu-24.5 {TkSetWindowMenuBar} {
     menu .m3
     list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
 } {0 {} {} {}}
-test menu-24.6 {TkSetWindowMenuBar} {
+test menu-25.6 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .m3}
@@ -2142,7 +2192,7 @@ test menu-24.6 {TkSetWindowMenuBar} {
     menu .m3
     list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
 } {0 {} {} {}}
-test menu-24.7 {TkSetWindowMenuBar} {
+test menu-25.7 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     catch {destroy .m2}
     . configure -menu ""
@@ -2153,7 +2203,7 @@ test menu-24.7 {TkSetWindowMenuBar} {
     .t2 configure -menu .m1
     list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
 } {0 {} {} {}}
-test menu-24.8 {TkSetWindowMenuBar} {
+test menu-25.8 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .t2}
@@ -2166,7 +2216,7 @@ test menu-24.8 {TkSetWindowMenuBar} {
     .t2 configure -menu .m1
     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
 } {0 {} {} {}}
-test menu-24.9 {TkSetWindowMenuBar} {
+test menu-25.9 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .t2}
@@ -2181,7 +2231,7 @@ test menu-24.9 {TkSetWindowMenuBar} {
     wm geometry .t3 +0+0
     list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
 } {0 {} {} {}}
-test menu-24.10 {TkSetWindowMenuBar} {
+test menu-25.10 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .t2}
@@ -2196,7 +2246,7 @@ test menu-24.10 {TkSetWindowMenuBar} {
     wm geometry .t3 +0+0
     list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
 } {0 {} {} {}}
-test menu-24.11 {TkSetWindowMenuBar} {
+test menu-25.11 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     catch {destroy .m2}
     catch {destroy .t2}
@@ -2211,27 +2261,27 @@ test menu-24.11 {TkSetWindowMenuBar} {
     wm geometry .t3 +0+0
     list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
 } {0 {} {} {}}
-test menu-24.12 {TkSetWindowMenuBar} {
+test menu-25.12 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test menu-24.13 {TkSetWindowMenuBar} {
+test menu-25.13 {TkSetWindowMenuBar} {
     . configure -menu ""
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
 } {0 {} {}}
-test menu-24.14 {TkSetWindowMenuBar} {
+test menu-25.14 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test menu-24.15 {TkSetWindowMenuBar} {
+test menu-25.15 {TkSetWindowMenuBar} {
     . configure -menu ""
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
 } {0 {} {}}
-test menu-24.16 {TkSetWindowMenuBar} {
+test menu-25.16 {TkSetWindowMenuBar} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
@@ -2239,7 +2289,7 @@ test menu-24.16 {TkSetWindowMenuBar} {
     list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
 } {0 .t2 {} {}}
 
-test menu-25.1 {DestroyMenuHashTable} {
+test menu-26.1 {DestroyMenuHashTable} {
     catch {interp destroy testinterp}
     interp create testinterp
     load {} Tk testinterp
@@ -2247,18 +2297,18 @@ test menu-25.1 {DestroyMenuHashTable} {
     list [catch {interp delete testinterp} msg] $msg
 } {0 {}}
 
-test menu-26.1 {GetMenuHashTable} {
+test menu-27.1 {GetMenuHashTable} {
     catch {interp destroy testinterp}
     interp create testinterp
     load {} tk testinterp
     list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
 } {0 .m1 {}}
 
-test menu-27.1 {TkCreateMenuReferences - not there before} {
+test menu-28.1 {TkCreateMenuReferences - not there before} {
     catch {destroy .m1}
     list [catch {menu .m1} msg] $msg [destroy .m1]
 } {0 .m1 {}}
-test menu-27.2 {TkCreateMenuReferences - there already} {
+test menu-28.2 {TkCreateMenuReferences - there already} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -2266,14 +2316,14 @@ test menu-27.2 {TkCreateMenuReferences - there already} {
     list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
 } {0 .m2 {}}
 
-test menu-28.1 {TkFindMenuReferences - not there} {
+test menu-29.1 {TkFindMenuReferences - not there} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
     .m1 add cascade -menu .m2
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test menu-29.1 {TkFindMenuReferences - there already} {
+test menu-30.1 {TkFindMenuReferences - there already} {
     catch {destroy .m1}
     catch {destroy .m2}
     . configure -menu ""
@@ -2283,23 +2333,23 @@ test menu-29.1 {TkFindMenuReferences - there already} {
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
 } {0 {} {} {}}
 
-test menu-30.1 {TkFreeMenuReferences - menuPtr} {
+test menu-31.1 {TkFreeMenuReferences - menuPtr} {
     catch {destroy .m1}
     menu .m1
     list [catch {destroy .m1} msg] $msg
 } {0 {}}
-test menu-30.2 {TkFreeMenuReferences - cascadePtr} {
+test menu-31.2 {TkFreeMenuReferences - cascadePtr} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
     .m1 add cascade -menu .m2
     list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-30.3 {TkFreeMenuReferences - topLevelListPtr} {
+test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} {
     . configure -menu .m1
     list [catch {. configure -menu ""} msg] $msg
 } {0 {}}
-test menu-30.4 {TkFreeMenuReferences - not empty} {
+test menu-31.4 {TkFreeMenuReferences - not empty} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -2309,7 +2359,7 @@ test menu-30.4 {TkFreeMenuReferences - not empty} {
     list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
 } {0 {} {}}
 
-test menu-31.1 {DeleteMenuCloneEntries} {
+test menu-32.1 {DeleteMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -2317,7 +2367,7 @@ test menu-31.1 {DeleteMenuCloneEntries} {
     .m1 clone .m2
     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-31.2 {DeleteMenuCloneEntries} {
+test menu-32.2 {DeleteMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -2328,7 +2378,7 @@ test menu-31.2 {DeleteMenuCloneEntries} {
     .m1 clone .m2
     list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-31.3 {DeleteMenuCloneEntries} {
+test menu-32.3 {DeleteMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1 -tearoff 0
@@ -2340,7 +2390,7 @@ test menu-31.3 {DeleteMenuCloneEntries} {
     .m2 configure -tearoff 1
     list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-31.4 {DeleteMenuCloneEntries} {
+test menu-32.4 {DeleteMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -2352,7 +2402,7 @@ test menu-31.4 {DeleteMenuCloneEntries} {
     .m2 configure -tearoff 0
     list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-31.5 {DeleteMenuCloneEntries} {
+test menu-32.5 {DeleteMenuCloneEntries} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -2362,17 +2412,23 @@ test menu-31.5 {DeleteMenuCloneEntries} {
     .m1 activate one
     list [catch {.m1 delete one} msg] $msg [destroy .m1]
 } {0 {} {}}
-test menu-31.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
+test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
     list [catch {.m1 invoke test} msg] $msg [destroy .m1]
 } {0 {} {}}
+test menu-32.7 {DeleteMenuCloneEntries - one entry} {
+    catch {destroy .m1}
+    menu .m1 -tearoff 0
+    .m1 add command -label Hello
+    list [catch {.m1 delete Hello} msg] $msg [destroy .m1]
+} {0 {} {}}
 
 set l [interp hidden]
 eval destroy [winfo children .]
 
-test menu-32.1 {menu vs command hiding} {
+test menu-33.1 {menu vs command hiding} {
     catch {destroy .m}
     menu .m
     interp hide {} .m
@@ -2382,4 +2438,20 @@ test menu-32.1 {menu vs command hiding} {
 
 # menu-34 MenuInit only called at boot time
 
+# cleanup
 deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/menuDraw.test b/tests/menuDraw.test
index b142f98..fdb051b 100644
--- a/tests/menuDraw.test
+++ b/tests/menuDraw.test
@@ -2,23 +2,23 @@
 # organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: menuDraw.test,v 1.2 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: menuDraw.test,v 1.3 1999/04/16 01:51:39 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 proc deleteWindows {} {
     foreach i [winfo children .] {
     	catch [destroy $i]
@@ -29,16 +29,6 @@ deleteWindows
 wm geometry . {}
 raise .
 
-if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
-    puts " Some tests were skipped because they could not be performed"
-    puts " automatically on this platform. If you wish to execute them"
-    puts " interactively, set the TCL variable INTERACTIVE and re-run"
-    puts " the test."
-    set testConfig(menuInteractive) 0
-} else {
-    set testConfig(menuInteractive) 1
-}
-
 test menuDraw-1.1 {TkMenuInitializeDrawingFields} {
     catch {destroy .m1}
     list [menu .m1] [destroy .m1]
@@ -118,7 +108,7 @@ test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} {
     menu .m1
     .m1 add command -label "foo"
     list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1]
-} {1 {bad state value "foo": must be normal, active, or disabled} {}}
+} {1 {bad state "foo": must be active, normal, or disabled} {}}
 test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} {
     catch {destroy .m1}
     menu .m1
@@ -191,7 +181,7 @@ test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} {
 } {{} {}}
 
 
-test menuDraw-8.1 {TkRecomputeMenu} {menuInteractive} {
+test menuDraw-8.1 {TkRecomputeMenu} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 configure -postcommand [.m1 add command -label foo]
@@ -506,7 +496,7 @@ test menuDraw-16.5 {TkPostSubMenu} {unixOnly} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2]
 } {1 {invalid command name "glorp"} {} {}}
-test menuDraw-16.6 {TkPostSubMenu} {menuInteractive} {
+test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -532,7 +522,7 @@ test menuDraw-17.1 {AdjustMenuCoords - menubar} {unixOnly} {
     }
     list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2]
 } {{} {} {} {}}
-test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} {
+test menuDraw-17.2 {AdjustMenuCoords - menu} {pcOnly userInteraction} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1
@@ -543,4 +533,20 @@ test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} {
     list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
 } {{} {} {}}
 
+# cleanup
 deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/menubut.test b/tests/menubut.test
index 9bdf04c..89d46d8 100644
--- a/tests/menubut.test
+++ b/tests/menubut.test
@@ -3,27 +3,27 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: menubut.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
+# RCS: @(#) $Id: menubut.test,v 1.3 1999/04/16 01:51:39 stanton 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,
 # XXX but many procedures have no tests.
 
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 foreach i [winfo children .] {
     destroy $i
 }
@@ -51,7 +51,7 @@ foreach test {
 	    {unknown color name "non-existent"}}
     {-activeforeground #ff0000 #ff0000 non-existent
 	    {unknown color name "non-existent"}}
-    {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
+    {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
     {-background #ff0000 #ff0000 non-existent
 	    {unknown color name "non-existent"}}
     {-bd 4 4 badValue {bad screen distance "badValue"}}
@@ -59,7 +59,7 @@ foreach test {
     {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
-    {-direction below below badValue {bad direction value "badValue": must be above, below, left, right, or flush}}
+    {-direction below below badValue {bad direction "badValue": must be above, below, flush, left, or right}}
     {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
     {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
@@ -74,8 +74,8 @@ foreach test {
     {-menu "any old string" "any old string" {} {}}
     {-padx 12 12 420x {bad screen distance "420x"}}
     {-pady 12 12 420x {bad screen distance "420x"}}
-    {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
-    {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
+    {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+    {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal}}
     {-takefocus "any string" "any string" {} {}}
     {-text "Sample text" {Sample text} {} {}}
     {-textvariable i i {} {}}
@@ -122,7 +122,7 @@ test menubutton-3.1 {MenuButtonWidgetCmd procedure} {
 } {1 {wrong # args: should be ".mb option ?arg arg ...?"}}
 test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.mb c} msg] $msg
-} {1 {bad option "c": must be cget or configure}}
+} {1 {ambiguous option "c": must be cget or configure}}
 test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} {
     list [catch {.mb cget} msg] $msg
 } {1 {wrong # args: should be ".mb cget option"}}
@@ -204,7 +204,7 @@ test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} {
     menubutton .mb -text "Test"
     list [catch {.mb configure -direction badValue} msg] $msg \
 	[.mb cget -direction] [destroy .mb]
-} {1 {bad direction value "badValue": must be above, below, left, right, or flush} below {}}
+} {1 {bad direction "badValue": must be above, below, flush, left, or right} below {}}
 
 # XXX Need to add tests for several procedures here. XXX
 
@@ -314,7 +314,7 @@ test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} {
     pack .mb
     list [winfo reqwidth .mb] [winfo reqheight .mb]
 } {78 28}
-test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} {
+test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable} {
     # The following test is non-portable because the indicator's pixel
     # size varies to maintain constant absolute size.
 
@@ -324,7 +324,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} {
     pack .mb
     list [winfo reqwidth .mb] [winfo reqheight .mb]
 } {64 23}
-test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pc nonPortable} {
+test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable} {
     # The following test is non-portable because the indicator's pixel
     # size varies to maintain constant absolute size.
 
@@ -350,3 +350,19 @@ eval image delete [image names]
 eval destroy [winfo children .]
 option clear
 
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/msgbox.test b/tests/msgbox.test
index 0511c87..e9a16d4 100644
--- a/tests/msgbox.test
+++ b/tests/msgbox.test
@@ -2,23 +2,27 @@
 # It is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: msgbox.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
+# RCS: @(#) $Id: msgbox.test,v 1.3 1999/04/16 01:51:39 stanton Exp $
 #
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
+# Some tests require user interaction on non-unix platform
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+    [expr {$::tcltest::testConfig(userInteraction) || \
+	$::tcltest::testConfig(unixOnly)}]
+
 test msgbox-1.1 {tk_messageBox command} {
     list [catch {tk_messageBox -foo} msg] $msg
-} {1 {unknown option "-foo", must be -default, -icon, -message, -parent, -title or -type}}
+} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}}
 test msgbox-1.2 {tk_messageBox command} {
     list [catch {tk_messageBox -foo bar} msg] $msg
-} {1 {unknown option "-foo", must be -default, -icon, -message, -parent, -title or -type}}
+} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}}
 
 catch {tk_messageBox -foo bar} msg
 regsub -all ,      $msg "" options
@@ -38,23 +42,31 @@ test msgbox-1.4 {tk_messageBox command} {
 
 test msgbox-1.5 {tk_messageBox command} {
     list [catch {tk_messageBox -type foo} msg] $msg
-} {1 {invalid message box type "foo", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel}}
+} {1 {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}}
+
+proc createPlatformMsg {val} {
+    global tcl_platform
+    if {$tcl_platform(platform) == "unix"} {
+	return "invalid default button \"$val\""
+    }
+    return "bad -default value \"$val\": must be abort, retry, ignore, ok, cancel, no, or yes"
+}
 
 test msgbox-1.6 {tk_messageBox command} {
     list [catch {tk_messageBox -default 1.1} msg] $msg
-} {1 {invalid default button "1.1"}}
+} [list 1 [createPlatformMsg "1.1"]]
 
 test msgbox-1.7 {tk_messageBox command} {
     list [catch {tk_messageBox -default foo} msg] $msg
-} {1 {invalid default button "foo"}}
+} [list 1 [createPlatformMsg "foo"]]
 
 test msgbox-1.8 {tk_messageBox command} {
     list [catch {tk_messageBox -type yesno -default 3} msg] $msg
-} {1 {invalid default button "3"}}
+} [list 1 [createPlatformMsg "3"]]
 
 test msgbox-1.9 {tk_messageBox command} {
     list [catch {tk_messageBox -icon foo} msg] $msg
-} {1 {invalid icon "foo", must be error, info, question or warning}}
+} {1 {bad -icon value "foo": must be error, info, question, or warning}}
 
 test msgbox-1.10 {tk_messageBox command} {
     list [catch {tk_messageBox -parent foo.bar} msg] $msg
@@ -66,14 +78,6 @@ if {[info commands tkMessageBox] == ""} {
     set isNative 0
 }
 
-if {$isNative && ![info exists INTERACTIVE]} {
-    puts " Some tests were skipped because they could not be performed"
-    puts " automatically on this platform. If you wish to execute them"
-    puts " interactively, set the TCL variable INTERACTIVE and re-run"
-    puts " the test"
-    return
-}
-
 proc ChooseMsg {parent btn} {
     global isNative
     if {!$isNative} {
@@ -128,30 +132,52 @@ set specs {
 # Try out all combinations of (type) x (default button) and
 # (type) x (icon).
 #
+set count 1
 foreach spec $specs {
     set type [lindex $spec 0]
     set buttons [lindex $spec 3]
 
     set button [lindex $buttons 0]
-    test msgbox-2.1 {tk_messageBox command} {
+    test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} {
 	ChooseMsg $parent $button
 	tk_messageBox -title Hi -message "Please press $button" \
 	    -type $type
     } $button
+    incr count
 
     foreach icon {warning error info question} {
-	test msgbox-2.2 {tk_messageBox command -icon option} {
+	test msgbox-2.$count {tk_messageBox command -icon option} \
+		{nonUnixUserInteraction} {
 	    ChooseMsg $parent $button
 	    tk_messageBox -title Hi -message "Please press $button" \
 		-type $type -icon $icon
 	} $button
+        incr count
     }
 
     foreach button $buttons {
-	test msgbox-2.3 {tk_messageBox command} {
+	test msgbox-2.$count {tk_messageBox command} {nonUnixUserInteraction} {
 	    ChooseMsg $parent $button
 	    tk_messageBox -title Hi -message "Please press $button" \
 		-type $type -default $button
 	} "$button"
+        incr count
     }
 }
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/obj.test b/tests/obj.test
new file mode 100644
index 0000000..f24ff68
--- /dev/null
+++ b/tests/obj.test
@@ -0,0 +1,52 @@
+# This file is a Tcl script to test new object types in Tk.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: obj.test,v 1.2 1999/04/16 01:51:39 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+foreach i [winfo children .] {
+    destroy $i
+}
+wm geometry . {}
+raise .
+
+test obj-1.1 {TkGetPixelsFromObj} {
+} {}
+
+test obj-2.1 {FreePixelInternalRep} {
+} {}
+
+test obj-3.1 {DupPixelInternalRep} {
+} {}
+
+test obj-4.1 {SetPixelFromAny} {
+} {}
+
+
+
+eval destroy [winfo children .]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/oldpack.test b/tests/oldpack.test
index 984e4fe..a793304 100644
--- a/tests/oldpack.test
+++ b/tests/oldpack.test
@@ -4,14 +4,14 @@
 #
 # Copyright (c) 1991-1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: oldpack.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
+# RCS: @(#) $Id: oldpack.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 # First, test a single window packed in various ways in a parent
 
@@ -505,4 +505,20 @@ test pack-9.3 {information output} {
 } {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}}
 
 catch {destroy .pack}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/option.test b/tests/option.test
index 3acc8f8..339d723 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -3,14 +3,14 @@
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: option.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
+# RCS: @(#) $Id: option.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 catch {destroy .op1}
 catch {destroy .op2}
@@ -185,15 +185,9 @@ test option-14.12 {error conditions} {
     list [catch {option get .gorp.gorp a A} msg] $msg
 } {1 {bad window path name ".gorp.gorp"}}
 
-if {$tcl_platform(os) == "Win32s"} {
-    set option1 OPTION~2.FIL
-    set option2 OPTION~1.FIL
-    set option3 OPTION~3.FIL
-} else {
-    set option1 option.file1
-    set option2 option.file2
-    set option3 option.file3
-}
+set option1 [file join $::tcltest::testsDir option.file1]
+set option2 [file join $::tcltest::testsDir option.file2]
+set option3 [file join $::tcltest::testsDir option.file3]
 
 test option-15.1 {database files} {
     list [catch {option read non-existent} msg] $msg
@@ -229,4 +223,20 @@ test option-16.1 {ReadOptionFile} {
 
 catch {destroy .op1}
 catch {destroy .op2}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/pack.test b/tests/pack.test
index 0084de4..6f6adbd 100644
--- a/tests/pack.test
+++ b/tests/pack.test
@@ -3,14 +3,14 @@
 #
 # Copyright (c) 1993 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: pack.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
+# RCS: @(#) $Id: pack.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 # Utility procedures:
 
@@ -967,3 +967,20 @@ destroy .pack
 foreach i {pack1 pack2 pack3 pack4} {
     rename $i {}
 }
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/place.test b/tests/place.test
index aaa2537..ea4014b 100644
--- a/tests/place.test
+++ b/tests/place.test
@@ -2,14 +2,13 @@
 # organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: place.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
+# RCS: @(#) $Id: place.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -218,4 +217,20 @@ test place-8.2 {MasterStructureProc, mapping and unmapping slaves} {
 } {1 0 42 32 0 1}
 
 catch {destroy .t}
-concat
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/raise.test b/tests/raise.test
index 5c40341..14323c5 100644
--- a/tests/raise.test
+++ b/tests/raise.test
@@ -5,11 +5,10 @@
 #
 # Copyright (c) 1993-1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: raise.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
+# RCS: @(#) $Id: raise.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
 
 if {[info commands testmakeexist] == {}} {
     puts "This application hasn't been compiled with the \"testmakeexist\""
@@ -18,8 +17,9 @@ if {[info commands testmakeexist] == {}} {
     return
 }
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 # Procedure to create a bunch of overlapping windows, which should
 # make it easy to detect differences in order.
@@ -297,3 +297,20 @@ test raise-7.8 {errors in raise/lower commands} {
 foreach i [winfo child .] {
     destroy $i
 }
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/safe.test b/tests/safe.test
index 1a1970b..b134268 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -3,31 +3,28 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: safe.test,v 1.4 1999/04/16 01:25:55 stanton Exp $
+# RCS: @(#) $Id: safe.test,v 1.5 1999/04/16 01:51:40 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
-    puts "*** Destroying $i ***"; update idletasks
     destroy $i
 }
 
 # The set of hidden commands is platform dependent:
 
 if {"$tcl_platform(platform)" == "macintosh"} {
-    set hidden_cmds {beep bell cd clipboard echo exit fconfigure file glob grab load ls menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+    set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm}
 } elseif {"$tcl_platform(platform)" == "windows"} {
-    set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
 } else {
-    set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection send socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+    set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk toplevel wm}
 }
-puts "About to do 1"
 
 test safe-1.1 {Safe Tk loading into an interpreter} {
     catch {safe::interpDelete a}
@@ -51,7 +48,7 @@ test safe-1.3 {Safe Tk loading into an interpreter} {
     set l [lsort [interp aliases a]]
     safe::interpDelete a
     set l
-} {exit file load source}
+} {encoding exit file load source}
 
 test safe-2.1 {Unsafe commands not available} {
     catch {safe::interpDelete a}
@@ -99,19 +96,14 @@ test safe-3.2 {Unsafe commands are available hidden} {
     set status
 } ok
 
-# This test gets a panic on the Mac in Tk8.0.5.  It did not in 8.0.4,
-# and it also does not if you update before deleting.  This is just
-# revealing the weakness in the link between the container list and the
-# ports for the windows.  The same comment applies to safe-5.2
- 
-test safe-4.1 {testing loadTk} {unixOrPc} {
+test safe-4.1 {testing loadTk} {
     # no error shall occur, the user will
     # eventually see a new toplevel
     set i [safe::loadTk [safe::interpCreate]]
     interp eval $i {button .b -text "hello world!"; pack .b}
-# lets don't update because it might impy that the user has
-# to position the window (if the wm does not do it automatically)
-# and thus make the test suite not runable non interactively
+    # lets don't update because it might imply that the user has
+    # to position the window (if the wm does not do it automatically)
+    # and thus make the test suite not runable non interactively
     safe::interpDelete $i
 } {}
 
@@ -133,7 +125,7 @@ test safe-5.1 {loading Tk in safe interps without master's clearance} {
     set msg
 } {not allowed to start Tk by master's safe::TkInit}
 
-test safe-5.2 {multi-level Tk loading with clearance} {unixOrPc} {
+test safe-5.2 {multi-level Tk loading with clearance} {
     # No error shall occur in that test and no window
     # shall remain at the end.
     set i [safe::interpCreate]
@@ -173,4 +165,27 @@ test safe-6.2 {loadTk -use windowPath, conflicting -display} {
 } {conflicting -display :23.56 and -use }
 
 
+test safe-7.1 {canvas printing} {
+    set i [safe::loadTk [safe::interpCreate]]
+    set r [catch {interp eval $i {canvas .c; .c postscript}}]
+    safe::interpDelete $i
+    set r
+} 0
+
+# cleanup
 unset hidden_cmds
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/scale.test b/tests/scale.test
index adc50e9..01b1609 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -3,14 +3,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: scale.test,v 1.3 1998/11/03 02:06:43 stanton Exp $
+# RCS: @(#) $Id: scale.test,v 1.4 1999/04/16 01:51:40 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -56,18 +55,18 @@ foreach test {
     {-label "Some text" {Some text} {} {}}
     {-length 130 130 badValue {bad screen distance "badValue"}}
     {-orient horizontal horizontal badValue
-	    {bad orientation "badValue": must be vertical or horizontal}}
+	    {bad orient "badValue": must be horizontal or vertical}}
     {-orient horizontal horizontal {} {}}
-    {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
     {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
     {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
     {-resolution 2.0 2.0 badValue
 	    {expected floating-point number but got "badValue"}}
     {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
     {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
-    {-sliderrelief raised raised badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+    {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
     {-state disabled disabled badValue
-	    {bad state value "badValue": must be normal, active, or disabled}}
+	    {bad state "badValue": must be active, disabled, or normal}}
     {-state normal normal {} {}}
     {-takefocus "any string" "any string" {} {}}
     {-tickinterval 4.3 4.0 badValue
@@ -212,10 +211,10 @@ test scale-3.29 {ScaleWidgetCmd procedure} {
 } {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
 test scale-3.30 {ScaleWidgetCmd procedure} {
     list [catch {.s c} msg] $msg
-} {1 {bad option "c": must be cget, configure, coords, get, identify, or set}}
+} {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}}
 test scale-3.31 {ScaleWidgetCmd procedure} {
     list [catch {.s co} msg] $msg
-} {1 {bad option "co": must be cget, configure, coords, get, identify, or set}}
+} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}}
 test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
     proc kill args {
 	destroy .s
@@ -270,7 +269,7 @@ test scale-5.4 {ConfigureScale procedure} {
     catch {destroy .s}
     scale .s -from 0 -to 100
     list [catch {.s configure -orient dumb} msg] $msg
-} {1 {bad orientation "dumb": must be vertical or horizontal}}
+} {1 {bad orient "dumb": must be horizontal or vertical}}
 test scale-5.5 {ConfigureScale procedure} {
     catch {destroy .s}
     scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
@@ -288,7 +287,7 @@ test scale-5.6 {ConfigureScale procedure} {
 test scale-5.7 {ConfigureScale procedure} {
     catch {destroy .s}
     list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
-} {1 {bad state value "bogus": must be normal, active, or disabled}}
+} {1 {bad state "bogus": must be active, disabled, or normal}}
 
 catch {destroy .s}
 scale .s -orient horizontal -length 200
@@ -360,7 +359,7 @@ test scale-6.13 {ComputeFormat procedure} {
     .s configure -from .000001 -to .00001 -resolution .000001
     .s set .000006
     expr {[.s get] == 6.0e-06}
-} 1
+} {1}
 test scale-6.14 {ComputeFormat procedure} {
     .s configure -to .00001 -from .0001 -resolution .00001
     .s set .00006
@@ -370,12 +369,12 @@ test scale-6.15 {ComputeFormat procedure} {
     .s configure -to .000001 -from .00001 -resolution .000001
     .s set .000006
     expr {[.s get] == 6.0e-06}
-} 1
+} {1}
 test scale-6.16 {ComputeFormat procedure} {
     .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
     .s set .00006
     expr {[.s get] == 6e-05}
-} 1
+} {1}
 test scale-6.17 {ComputeFormat procedure} {
     .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
     .s set 49300000
@@ -799,3 +798,20 @@ test scale-16.1 {scale widget vs hidden commands} {
 
 catch {destroy .s}
 option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/scrollbar.test b/tests/scrollbar.test
index 7790b05..0328043 100644
--- a/tests/scrollbar.test
+++ b/tests/scrollbar.test
@@ -4,14 +4,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: scrollbar.test,v 1.2 1998/09/14 18:23:50 stanton Exp $
+# RCS: @(#) $Id: scrollbar.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -170,16 +169,16 @@ test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} {
     list [catch {.s cget -orient} msg] $msg
 } {0 vertical}
 scrollbar .s2
-test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
+test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
     list [catch {.s2 cget -bd} msg] $msg
 } {0 0}
-test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} {
+test scrollbar-3.12 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
     list [catch {.s2 cget -bd} msg] $msg
 } {0 2}
-test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
+test scrollbar-3.13 {ScrollbarWidgetCmd procedure, "cget" option} {pcOnly} {
     list [catch {.s2 cget -highlightthickness} msg] $msg
 } {0 0}
-test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {!pc} {
+test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
     list [catch {.s2 cget -highlightthickness} msg] $msg
 } {0 1}
 destroy .s2
@@ -662,4 +661,20 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} {
 
 catch {destroy .s}
 catch {destroy .t}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/select.test b/tests/select.test
index d449f7c..9f1e6a6 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -3,19 +3,18 @@
 # fashion for Tcl tests.
 #
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: select.test,v 1.2 1998/09/14 18:23:50 stanton Exp $
+# RCS: @(#) $Id: select.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
 
 #
 # Note: Multiple display selection handling will only be tested if the
 # environment variable TK_ALT_DISPLAY is set to an alternate display.
 #
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 eval destroy [winfo child .]
@@ -449,10 +448,10 @@ test select-5.10 {Tk_GetSelection procedure} {unixOnly} {
     set selInfo ""
     selection own .f1
     set result ""
-    fileevent $fd readable {}
-    puts $fd {catch {selection get TEST} msg; update; puts $msg; flush stdout}
-    flush $fd
-    lappend result [gets $fd]
+    fileevent $::tcltest::fd readable {}
+    puts $::tcltest::fd {catch {selection get TEST} msg; update; puts $msg; flush stdout}
+    flush $::tcltest::fd
+    lappend result [gets $::tcltest::fd]
     cleanupbg
     lappend result $selInfo
 } {{selection owner didn't respond} {}}
@@ -814,14 +813,14 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} {unixOn
     set selInfo ""
     selection handle .f1 {handler STRING}
     update
-    puts $fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout}
-    flush $fd
+    puts $::tcltest::fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout}
+    flush $::tcltest::fd
     after 200
     selection own .
-    set bgData {}
-    tkwait variable bgDone
+    set ::tcltest::bgData {}
+    tkwait variable ::tcltest::bgDone
     cleanupbg
-    list $bgData $selInfo
+    list $::tcltest::bgData $selInfo
 } {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}}
 test select-10.2 {ConvertSelection procedure} {unixOnly} {
     setup
@@ -984,4 +983,20 @@ test select-13.1 {SelectionSize procedure, handler deleted} {unixOnly} {
 } {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}
 
 catch {rename weirdHandler {}}
-concat
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/send.test b/tests/send.test
index 2f6e7d1..816151e 100644
--- a/tests/send.test
+++ b/tests/send.test
@@ -4,28 +4,31 @@
 #
 # Copyright (c) 1994 Sun Microsystems, Inc.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: send.test,v 1.2 1998/09/14 18:23:50 stanton Exp $
+# RCS: @(#) $Id: send.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {$tcl_platform(platform) == "macintosh"} {
     puts "send is not available on the Mac - skipping tests"
+    ::tcltest::cleanupTests
     return
 }
 if {$tcl_platform(platform) == "window"} {
     puts "send is not available under Windows - skipping tests"
+    ::tcltest::cleanupTests
     return
 }
 if {[auto_execok xhost] == ""} {
     puts "xhost application isn't available - skipping tests"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
 if {[info commands testsend] == "testsend"} {
     set gotTestCmds 1
 } else {
@@ -48,6 +51,7 @@ if {[catch {send $app set a 0} msg] == 1} {
 	puts -nonewline "Your X server is insecure, so \"send\" can't be used;"
 	puts " skipping \"send\" tests."
 	cleanupbg
+	::tcltest::cleanupTests
 	return
     }
 }
@@ -325,6 +329,8 @@ if $gotTestCmds {
     while executing
 "open bogus_file_name"
     invoked from within
+"if 1 {open bogus_file_name}"
+    invoked from within
 "send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
     test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {
 	testsend prop root InterpRegistry "10234 bogus\n"
@@ -546,7 +552,7 @@ r
 	setupbg
 	dobg {tk appname t_s_3}
 	set x [list [catch {send t_s_3 exit} msg] $msg]
-	close $fd
+	close $::tcltest::fd
 	set x
     } {1 {target application died}}
 
@@ -577,15 +583,15 @@ test send-12.2 {TimeoutProc procedure} {
     tk appname tktest
     update
     setupbg
-    puts $fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
-    set bgDone 0
-    set bgData {}
-    flush $fd
-    tkwait variable bgDone
-    set app $bgData
+    puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
+    set ::tcltest::bgDone 0
+    set ::tcltest::bgData {}
+    flush $::tcltest::fd
+    tkwait variable ::tcltest::bgDone
+    set app $::tcltest::bgData
     after 200
     set result [list [catch {send $app foo} msg] $msg]
-    close $fd
+    close $::tcltest::fd
     set result
 } {1 {target application died}}
 
@@ -654,3 +660,20 @@ if $gotTestCmds {
     testdeleteapps
 }
 rename newApp {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/text.test b/tests/text.test
index 62d5839..fd953d0 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -3,14 +3,14 @@
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: text.test,v 1.2 1998/09/14 18:23:50 stanton Exp $
+# RCS: @(#) $Id: text.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 eval destroy [winfo child .]
 
@@ -906,7 +906,7 @@ test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
 } {2.13 {}}
 test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
     list [catch {.t search -regexp a( 1.0} msg] $msg
-} {1 {couldn't compile regular expression pattern: unmatched ()}}
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
 test text-20.19 {TextSearchCmd procedure, skip dummy last line} {
     .t search -backwards BaR end 1.0
 } {2.23}
@@ -1082,6 +1082,27 @@ test text-20.62 {TextSearchCmd, freeing copy of pattern} {
     set p $p$p$p$p$p
     .t search -nocase $p 1.0
 } {}
+test text-20.63 {TextSearchCmd, unicode} {
+    .t delete 1.0 end
+    .t insert end "foo\u30c9\u30cabar"
+    .t search \u30c9\u30ca 1.0
+} 1.3
+test text-20.64 {TextSearchCmd, unicode} {
+    .t delete 1.0 end
+    .t insert end "foo\u30c9\u30cabar"
+    list [.t search -count n \u30c9\u30ca 1.0] $n
+} {1.3 2}
+test text-20.65 {TextSearchCmd, unicode with non-text segments} {
+    .t delete 1.0 end
+    button .b1 -text baz
+    .t insert end "foo\u30c9"
+    .t window create end -window .b1
+    .t insert end "\u30cabar"
+    set result [list [.t search -count n \u30c9\u30ca 1.0] $n]
+    destroy .b1
+    set result
+} {1.3 3}
+
 
 eval destroy [winfo child .]
 text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
@@ -1260,3 +1281,20 @@ test text-23.1 {text widget vs hidden commands} {
 
 eval destroy [winfo child .]
 option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/textBTree.test b/tests/textBTree.test
index d59a9b8..855a8f3 100644
--- a/tests/textBTree.test
+++ b/tests/textBTree.test
@@ -5,14 +5,14 @@
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: textBTree.test,v 1.2 1998/09/14 18:23:50 stanton Exp $
+# RCS: @(#) $Id: textBTree.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 catch {destroy .t}
 text .t
@@ -893,5 +893,21 @@ test btree-18.9 {tag search back, large complex btree spans} {
     list [.t tag prev x end] [.t tag prev x 433.0]
 } {{500.0 520.0} {200.0 220.0}}
 
-
 destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 9741fdc..7ae7f25 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -3,17 +3,16 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: textDisp.test,v 1.2 1998/09/14 18:23:50 stanton Exp $
+# RCS: @(#) $Id: textDisp.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
-    if {$testConfig(fonts) == 0} {
-	puts "skipping font-sensitive tests"
-    }
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+if {$::tcltest::testConfig(fonts) == 0} {
+    puts "skipping font-sensitive tests"
 }
 
 # The procedure below is used as the scrolling command for the text;
@@ -2866,3 +2865,20 @@ foreach i [winfo children .] {
     catch {destroy $i}
 }
 option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/textImage.test b/tests/textImage.test
index e639097..9b17358 100644
--- a/tests/textImage.test
+++ b/tests/textImage.test
@@ -1,7 +1,17 @@
-# RCS: @(#) $Id: textImage.test,v 1.2 1998/09/14 18:23:51 stanton Exp $
-
-if {[string compare test [info procs test]] == 1} then \
-  {source ../tests/defs}
+# textImage.test -- test images embedded in text widgets
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: textImage.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 # Test Arguments:
 # name -                Name of test, in the form foo-1.2.
@@ -9,7 +19,7 @@ if {[string compare test [info procs test]] == 1} then \
 #                       help humans understand what it does.
 # constraints -         A list of one or more keywords, each of
 #                       which must be the name of an element in
-#                       the array "testConfig".  If any of these
+#                       the array "::tcltest::testConfig".  If any of these
 #                       elements is zero, the test is skipped.
 #                       This argument may be omitted.
 # script -              Script to run to carry out the test.  It must
@@ -351,3 +361,20 @@ test textImage-4.3 {alignment and padding checking} {fonts} {
 catch {destroy .t}
 foreach image [image names] {image delete $image}
 font delete test_font
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/textIndex.test b/tests/textIndex.test
index 1744834..2bfdbc1 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -3,21 +3,22 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: textIndex.test,v 1.2 1998/09/14 18:23:51 stanton Exp $
+# RCS: @(#) $Id: textIndex.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# Some tests require the testtext command
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+set ::tcltest::testConfig(testtext) \
+	[expr {[info commands testtext] != {}}]
 
 catch {destroy .t}
-if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
-    puts "The font needed by these tests isn't available, so I'm"
-    puts "going to skip the tests."
-    return
-}
+text .t -font {Courier -12} -width 20 -height 10
 pack append . .t {top expand fill}
 update
 .t debug on
@@ -35,73 +36,181 @@ wm deiconify .
 abcdefghijklm
 12345
 Line 4
-bOy GIrl .#@? x_yz
+b\u4e4fy GIrl .#@? x_yz
 !@#$%
 Line 7"
 
-test textIndex-1.1 {TkTextMakeIndex} {
+image create photo textimage -width 10 -height 10
+textimage put red -to 0 0 9 9
+
+test textIndex-1.1 {TkTextMakeByteIndex} {testtext} {
+    # (lineIndex < 0)
+    testtext .t byteindex -1 3
+} {1.0 0}
+test textIndex-1.2 {TkTextMakeByteIndex} {testtext} {
+    # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1
+    testtext .t byteindex 0 3
+} {1.0 0}
+test textIndex-1.3 {TkTextMakeByteIndex} {testtext} {
+    # not (lineIndex < 0)
+    testtext .t byteindex 1 3
+} {1.3 3}
+test textIndex-1.4 {TkTextMakeByteIndex} {testtext} {
+    # (byteIndex < 0)
+    testtext .t byteindex 3 -1
+} {3.0 0}
+test textIndex-1.5 {TkTextMakeByteIndex} {testtext} {
+    # not (byteIndex < 0)
+    testtext .t byteindex 3 3
+} {3.3 3}
+test textIndex-1.6 {TkTextMakeByteIndex} {testtext} {
+    # (indexPtr->linePtr == NULL)
+    testtext .t byteindex 9 2
+} {8.0 0}
+test textIndex-1.7 {TkTextMakeByteIndex} {testtext} {
+    # not (indexPtr->linePtr == NULL)
+    testtext .t byteindex 7 2
+} {7.2 2}
+test textIndex-1.8 {TkTextMakeByteIndex: shortcut for 0} {testtext} {
+    # (byteIndex == 0)
+    testtext .t byteindex 1 0
+} {1.0 0}
+test textIndex-1.9 {TkTextMakeByteIndex: shortcut for 0} {testtext} {
+    # not (byteIndex == 0)
+    testtext .t byteindex 3 80
+} {3.5 5}
+test textIndex-1.10 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+    # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) 
+    # one segment
+
+    testtext .t byteindex 3 5
+} {3.5 5}
+test textIndex-1.11 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+    # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+    #     index += segPtr->size
+    # Multiple segments, make sure add segment size to index.
+
+    .t mark set foo 3.2 
+    set x [testtext .t byteindex 3 7]
+    .t mark unset foo
+    set x
+} {3.5 5}
+test textIndex-1.12 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+    # (segPtr == NULL)
+    testtext .t byteindex 3 7
+} {3.5 5}
+test textIndex-1.13 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+    # not (segPtr == NULL)
+    testtext .t byteindex 3 4
+} {3.4 4}
+test textIndex-1.14 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+    # (index + segPtr->size > byteIndex)
+    # in this segment.
+
+    testtext .t byteindex 3 4
+} {3.4 4}
+test textIndex-1.15 {TkTextMakeByteIndex: verify index is in range} {testtext} {
+    # (index + segPtr->size > byteIndex), index != 0
+    # in this segment.
+
+    .t mark set foo 3.2
+    set x [testtext .t byteindex 3 4]
+    .t mark unset foo
+    set x
+} {3.4 4}
+test textIndex-1.16 {TkTextMakeByteIndex: UTF-8 characters} {testtext} {
+    testtext .t byteindex 5 100
+} {5.18 20}
+test textIndex-1.17 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
+	{testtext} {
+    # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) 
+    # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).
+
+    set x [testtext .t byteindex 5 2]
+    list $x [.t get insert]
+} {{5.2 4} y}
+test textIndex-1.18 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
+	{testtext} {
+    # ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) 
+    testtext .t byteindex 5 1
+    .t get insert
+} "\u4e4f"
+
+test textIndex-2.1 {TkTextMakeCharIndex} {
+    # (lineIndex < 0)
     .t index -1.3
 } 1.0
-test textIndex-1.2 {TkTextMakeIndex} {
+test textIndex-2.2 {TkTextMakeCharIndex} {
+    # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1
     .t index 0.3
 } 1.0
-test textIndex-1.3 {TkTextMakeIndex} {
+test textIndex-2.3 {TkTextMakeCharIndex} {
+    # not (lineIndex < 0)
     .t index 1.3
 } 1.3
-test textIndex-1.4 {TkTextMakeIndex} {
+test textIndex-2.4 {TkTextMakeCharIndex} {
+    # (charIndex < 0)
     .t index 3.-1
 } 3.0
-test textIndex-1.5 {TkTextMakeIndex} {
+test textIndex-2.5 {TkTextMakeCharIndex} {
+    # (charIndex < 0)
     .t index 3.3
 } 3.3
-test textIndex-1.6 {TkTextMakeIndex} {
+test textIndex-2.6 {TkTextMakeCharIndex} {
+    # (indexPtr->linePtr == NULL)
+    .t index 9.2
+} 8.0
+test textIndex-2.7 {TkTextMakeCharIndex} {
+    # not (indexPtr->linePtr == NULL)
+    .t index 7.2
+} 7.2
+test textIndex-2.8 {TkTextMakeCharIndex: verify index is in range} {
+    # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+    # one segment
+
     .t index 3.5
 } 3.5
-test textIndex-1.7 {TkTextMakeIndex} {
-    .t index 3.6
+test textIndex-2.9 {TkTextMakeCharIndex: verify index is in range} {
+    # for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+    # Multiple segments, make sure add segment size to index.
+
+    .t mark set foo 3.2 
+    set x [.t index 3.7]
+    .t mark unset foo
+    set x
 } 3.5
-test textIndex-1.8 {TkTextMakeIndex} {
+test textIndex-2.10 {TkTextMakeCharIndex: verify index is in range} {
+    # (segPtr == NULL)
     .t index 3.7
 } 3.5
-test textIndex-1.9 {TkTextMakeIndex} {
-    .t index 7.2
-} 7.2
-test textIndex-1.10 {TkTextMakeIndex} {
-    .t index 8.0
-} 8.0
-test textIndex-1.11 {TkTextMakeIndex} {
-    .t index 8.1
-} 8.0
-test textIndex-1.12 {TkTextMakeIndex} {
-    .t index 9.0
-} 8.0
+test textIndex-2.11 {TkTextMakeCharIndex: verify index is in range} {
+    # not (segPtr == NULL)
+    .t index 3.4
+} 3.4
+test textIndex-2.12 {TkTextMakeCharIndex: verify index is in range} {
+    # (segPtr->typePtr == &tkTextCharType)
+    # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).
+
+    .t mark set insert 5.2
+    .t get insert
+} y
+test textIndex-2.13 {TkTextMakeCharIndex: verify index is in range} {
+    # not (segPtr->typePtr == &tkTextCharType)
+
+    .t image create 5.2 -image textimage
+    .t mark set insert 5.5
+    set x [.t get insert]
+    .t delete 5.2
+    set x
+} "G"
+test textIndex-2.14 {TkTextMakeCharIndex: verify index is in range} {
+    # (charIndex < segPtr->size)
 
-.t tag add x 2.3 2.6
-test textIndex-2.1 {TkTextIndexToSeg} {
-    .t get 2.0
-} a
-test textIndex-2.2 {TkTextIndexToSeg} {
-    .t get 2.2
-} c
-test textIndex-2.3 {TkTextIndexToSeg} {
-    .t get 2.3
-} d
-test textIndex-2.4 {TkTextIndexToSeg} {
-    .t get 2.6
-} g
-test textIndex-2.5 {TkTextIndexToSeg} {
-    .t get 2.7
-} h
-test textIndex-2.6 {TkTextIndexToSeg} {
-    .t get 2.12
-} m
-test textIndex-2.7 {TkTextIndexToSeg} {
-    .t get 2.13
-} \n
-test textIndex-2.8 {TkTextIndexToSeg} {
-    .t get 2.14
-} \n
-.t tag delete x
+    .t image create 5.0 -image textimage
+    set x [.t index 5.0]
+    .t delete 5.0
+    set x
+} 5.0
 
 .t mark set foo 3.2
 .t tag add x 2.8 2.11
@@ -242,8 +351,8 @@ test textIndex-10.4 {ForwBack} {
     list [catch {.t index {2.3 - 3ch}} msg] $msg
 } {0 2.0}
 test textIndex-10.5 {ForwBack} {
-    list [catch {.t index {2.3 + 3 lines}} msg] $msg
-} {0 5.3}
+    list [catch {.t index {1.3 + 3 lines}} msg] $msg
+} {0 4.3}
 test textIndex-10.6 {ForwBack} {
     list [catch {.t index {2.3 -1l}} msg] $msg
 } {0 1.3}
@@ -253,97 +362,325 @@ test textIndex-10.7 {ForwBack} {
 test textIndex-10.8 {ForwBack} {
     list [catch {.t index {2.3 - 4 lines}} msg] $msg
 } {0 1.3}
+test textIndex-10.9 {ForwBack} {
+    .t mark set insert 2.0
+    list [catch {.t index {insert -0 chars}} msg] $msg
+} {0 2.0}
+test textIndex-10.10 {ForwBack} {
+    .t mark set insert 2.end
+    list [catch {.t index {insert +0 chars}} msg] $msg
+} {0 2.13}
 
-test textIndex-11.1 {TkTextIndexForwChars} {
+test textIndex-11.1 {TkTextIndexForwBytes} {testtext} {
+    testtext .t forwbytes 2.3 -7
+} {1.3 3}
+test textIndex-11.2 {TkTextIndexForwBytes} {testtext} {
+    testtext .t forwbytes 2.3 5
+} {2.8 8}
+test textIndex-11.3 {TkTextIndexForwBytes} {testtext} {
+    testtext .t forwbytes 2.3 10
+} {2.13 13}
+test textIndex-11.4 {TkTextIndexForwBytes} {testtext} {
+    testtext .t forwbytes 2.3 11
+} {3.0 0}
+test textIndex-11.5 {TkTextIndexForwBytes} {testtext} {
+    testtext .t forwbytes 2.3 57
+} {7.6 6}
+test textIndex-11.6 {TkTextIndexForwBytes} {testtext} {
+    testtext .t forwbytes 2.3 58
+} {8.0 0}
+test textIndex-11.7 {TkTextIndexForwBytes} {testtext} {
+    testtext .t forwbytes 2.3 59
+} {8.0 0}
+
+test textIndex-12.1 {TkTextIndexForwChars} {
+    # (charCount < 0)
     .t index {2.3 + -7 chars}
 } 1.3
-test textIndex-11.2 {TkTextIndexForwChars} {
+test textIndex-12.2 {TkTextIndexForwChars} {
+    # not (charCount < 0)
     .t index {2.3 + 5 chars}
 } 2.8
-test textIndex-11.3 {TkTextIndexForwChars} {
+test textIndex-12.3 {TkTextIndexForwChars: find index} {
+    # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
+    # one loop
+    .t index {2.3 + 9 chars}
+} 2.12
+test textIndex-12.4 {TkTextIndexForwChars: find index} {
+    # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
+    # multiple loops
+    .t mark set foo 2.5
+    set x [.t index {2.3 + 9 chars}]
+    .t mark unset foo
+    set x
+} 2.12
+test textIndex-12.5 {TkTextIndexForwChars: find index} {
+    # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
+    # border condition: last char
+
     .t index {2.3 + 10 chars}
 } 2.13
-test textIndex-11.4 {TkTextIndexForwChars} {
+test textIndex-12.6 {TkTextIndexForwChars: find index} {
+    # for ( ; segPtr != NULL; segPtr = segPtr->nextPtr)
+    # border condition: segPtr == NULL -> beginning of next line
+    
     .t index {2.3 + 11 chars}
 } 3.0
-test textIndex-11.5 {TkTextIndexForwChars} {
-    .t index {2.3 + 55 chars}
-} 7.6
-test textIndex-11.6 {TkTextIndexForwChars} {
+test textIndex-12.7 {TkTextIndexForwChars: find index} {
+    # (segPtr->typePtr == &tkTextCharType)
+    .t index {2.3 + 2 chars}
+} 2.5
+test textIndex-12.8 {TkTextIndexForwChars: find index} {
+    # (charCount == 0)
+    # No more chars, so we found byte offset.
+
+    .t index {2.3 + 2 chars}
+} 2.5
+test textIndex-12.9 {TkTextIndexForwChars: find index} {
+    # not (segPtr->typePtr == &tkTextCharType)
+
+    .t image create 2.4 -image textimage
+    set x [.t get {2.3 + 3 chars}]
+    .t delete 2.4
+    set x    
+} "f"
+test textIndex-12.10 {TkTextIndexForwChars: find index} {
+    # dstPtr->byteIndex += segPtr->size - byteOffset
+    # When moving to next segment, account for bytes in last segment.
+    # Wrong answer would be 2.4
+
+    .t mark set foo 2.4
+    set x [.t index {2.3 + 5 chars}]
+    .t mark unset foo
+    set x
+} 2.8
+test textIndex-12.11 {TkTextIndexForwChars: go to next line} {
+    # (linePtr == NULL)
+    .t index {7.6 + 3 chars}
+} 8.0
+test textIndex-12.12 {TkTextIndexForwChars: go to next line} {
+    # Reset byteIndex to 0 now that we are on a new line.
+    # Wrong answer would be 2.9
+    .t index {1.3 + 6 chars}
+} 2.2
+test textIndex-12.13 {TkTextIndexForwChars} {
+    # right to end
     .t index {2.3 + 56 chars}
 } 8.0
-test textIndex-11.7 {TkTextIndexForwChars} {
+test textIndex-12.14 {TkTextIndexForwChars} {
+    # try to go past end
     .t index {2.3 + 57 chars}
 } 8.0
 
-test textIndex-12.1 {TkTextIndexBackChars} {
+test textIndex-13.1 {TkTextIndexBackBytes} {testtext} {
+    testtext .t backbytes 3.2 -10
+} {4.6 6}
+test textIndex-13.2 {TkTextIndexBackBytes} {testtext} {
+    testtext .t backbytes 3.2 2
+} {3.0 0}
+test textIndex-13.3 {TkTextIndexBackBytes} {testtext} {
+    testtext .t backbytes 3.2 3
+} {2.13 13}
+test textIndex-13.4 {TkTextIndexBackBytes} {testtext} {
+    testtext .t backbytes 3.2 22
+} {1.1 1}
+test textIndex-13.5 {TkTextIndexBackBytes} {testtext} {
+    testtext .t backbytes 3.2 23
+} {1.0 0}
+test textIndex-13.6 {TkTextIndexBackBytes} {testtext} {
+    testtext .t backbytes 3.2 24
+} {1.0 0}
+
+test textIndex-14.1 {TkTextIndexBackChars} {
+    # (charCount < 0)
     .t index {3.2 - -10 chars}
 } 4.6
-test textIndex-12.2 {TkTextIndexBackChars} {
+test textIndex-14.2 {TkTextIndexBackChars} {
+    # not (charCount < 0)
     .t index {3.2 - 2 chars}
 } 3.0
-test textIndex-12.3 {TkTextIndexBackChars} {
+test textIndex-14.3 {TkTextIndexBackChars: find starting segment} {
+    # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+    # single loop
+
     .t index {3.2 - 3 chars}
 } 2.13
-test textIndex-12.4 {TkTextIndexBackChars} {
+test textIndex-14.4 {TkTextIndexBackChars: find starting segment} {
+    # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+    # multiple loop
+
+    .t mark set foo1 2.5
+    .t mark set foo2 2.7
+    .t mark set foo3 2.10
+    set x [.t index {2.9 - 1 chars}]
+    .t mark unset foo1 foo2 foo3
+    set x
+} 2.8
+test textIndex-14.5 {TkTextIndexBackChars: find starting seg and offset} {
+    # for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr)
+    # Make sure segSize was decremented.  Wrong answer would be 2.10
+
+    .t mark set foo 2.2
+    set x [.t index {2.9 - 1 char}]
+    .t mark unset foo
+    set x
+} 2.8
+test textIndex-14.6 {TkTextIndexBackChars: back over characters} {
+    # (segPtr->typePtr == &tkTextCharType)
+
     .t index {3.2 - 22 chars}
 } 1.1
-test textIndex-12.5 {TkTextIndexBackChars} {
-    .t index {3.2 - 23 chars}
-} 1.0
-test textIndex-12.6 {TkTextIndexBackChars} {
-    .t index {3.2 - 24 chars}
+test textIndex-14.7 {TkTextIndexBackChars: loop backwards over chars} {
+    # (charCount == 0)
+    # No more chars, so we found byte offset.
+
+    .t index {3.4 - 2 chars}
+} 3.2
+test textIndex-14.8 {TkTextIndexBackChars: loop backwards over chars} {
+    # (p == start)
+    # Still more chars, but we reached beginning of segment
+
+    .t image create 5.6 -image textimage
+    set x [.t index {5.8 - 3 chars}]
+    .t delete 5.6
+    set x
+} 5.5
+test textIndex-14.9 {TkTextIndexBackChars: back over image} {
+    # not (segPtr->typePtr == &tkTextCharType)
+
+    .t image create 5.6 -image textimage
+    set x [.t get {5.8 - 4 chars}]
+    .t delete 5.6
+    set x
+} "G"
+test textIndex-14.10 {TkTextIndexBackChars: move to previous segment} {
+    # (segPtr != oldPtr)
+    # More segments to go
+
+    .t mark set foo 3.4
+    set x [.t index {3.5 - 2 chars}]
+    .t mark unset foo
+    set x
+} 3.3
+test textIndex-14.11 {TkTextIndexBackChars: move to previous segment} {
+    # not (segPtr != oldPtr)
+    # At beginning of line.
+
+    .t mark set foo 3.4
+    set x [.t index {3.5 - 10 chars}]
+    .t mark unset foo
+    set x
+} 2.9
+test textIndex-14.12 {TkTextIndexBackChars: move to previous line} {
+    # (lineIndex == 0) 
+    .t index {1.5 - 10 chars}
 } 1.0
+test textIndex-14.13 {TkTextIndexBackChars: move to previous line} {
+    # not (lineIndex == 0) 
+    .t index {2.5 - 10 chars}
+} 1.2
+test textIndex-14.14 {TkTextIndexBackChars: move to previous line} {
+    # for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr)
+    # Set byteIndex to end of previous line so we can subtract more
+    # bytes from it.  Otherwise we get an TkTextIndex with a negative
+    # byteIndex.
+
+    .t index {2.5 - 6 chars}
+} 1.6
+test textIndex-14.15 {TkTextIndexBackChars: UTF} {
+    .t get {5.3 - 1 chars}
+} y
+test textIndex-14.16 {TkTextIndexBackChars: UTF} {
+    .t get {5.3 - 2 chars}
+} \u4e4f
+test textIndex-14.17 {TkTextIndexBackChars: UTF} {
+    .t get {5.3 - 3 chars}
+} b
 
 proc getword index {
     .t get [.t index "$index wordstart"] [.t index "$index wordend"]
 }
-test textIndex-13.1 {StartEnd} {
+test textIndex-15.1 {StartEnd} {
     list [catch {.t index {2.3 lineend}} msg] $msg
 } {0 2.13}
-test textIndex-13.2 {StartEnd} {
+test textIndex-15.2 {StartEnd} {
     list [catch {.t index {2.3 linee}} msg] $msg
 } {0 2.13}
-test textIndex-13.3 {StartEnd} {
+test textIndex-15.3 {StartEnd} {
     list [catch {.t index {2.3 line}} msg] $msg
 } {1 {bad text index "2.3 line"}}
-test textIndex-13.4 {StartEnd} {
+test textIndex-15.4 {StartEnd} {
     list [catch {.t index {2.3 linestart}} msg] $msg
 } {0 2.0}
-test textIndex-13.5 {StartEnd} {
+test textIndex-15.5 {StartEnd} {
     list [catch {.t index {2.3 lines}} msg] $msg
 } {0 2.0}
-test textIndex-13.6 {StartEnd} {
+test textIndex-15.6 {StartEnd} {
     getword 5.3
 } { }
-test textIndex-13.7 {StartEnd} {
+test textIndex-15.7 {StartEnd} {
     getword 5.4
 } GIrl
-test textIndex-13.8 {StartEnd} {
+test textIndex-15.8 {StartEnd} {
     getword 5.7
 } GIrl
-test textIndex-13.9 {StartEnd} {
+test textIndex-15.9 {StartEnd} {
     getword 5.8
 } { }
-test textIndex-13.10 {StartEnd} {
+test textIndex-15.10 {StartEnd} {
     getword 5.14
 } x_yz
-test textIndex-13.11 {StartEnd} {
+test textIndex-15.11 {StartEnd} {
     getword 6.2
 } #
-test textIndex-13.12 {StartEnd} {
+test textIndex-15.12 {StartEnd} {
     getword 3.4
 } 12345
 .t tag add x 2.8 2.11
-test textIndex-13.13 {StartEnd} {
+test textIndex-15.13 {StartEnd} {
     list [catch {.t index {2.2 worde}} msg] $msg
 } {0 2.13}
-test textIndex-13.14 {StartEnd} {
+test textIndex-15.14 {StartEnd} {
     list [catch {.t index {2.12 words}} msg] $msg
 } {0 2.0}
-test textIndex-13.15 {StartEnd} {
+test textIndex-15.15 {StartEnd} {
     list [catch {.t index {2.12 word}} msg] $msg
 } {1 {bad text index "2.12 word"}}
 
+test testIndex-16.1 {TkTextPrintIndex} {
+    set t [text .t2]
+    $t insert end \n
+    $t window create end -window [button $t.b]
+    set result [$t index end-2c]
+    pack $t
+    catch {destroy $t}
+} 0
+
+
+test testIndex-16.2 {TkTextPrintIndex} {
+    set t [text .t2]
+    $t insert end \n
+    $t window create end -window [button $t.b]
+    set result [$t tag add {} end-2c]
+    pack $t
+    catch {destroy $t}
+} 0
+
+# cleanup
+rename textimage {}
 catch {destroy .t}
-concat
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/textMark.test b/tests/textMark.test
index 6bc2589..775c252 100644
--- a/tests/textMark.test
+++ b/tests/textMark.test
@@ -3,19 +3,20 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: textMark.test,v 1.2 1998/09/14 18:23:51 stanton Exp $
+# RCS: @(#) $Id: textMark.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 catch {destroy .t}
 if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
     puts "The font needed by these tests isn't available, so I'm"
     puts "going to skip the tests."
+    ::tcltest::cleanupTests
     return
 }
 pack append . .t {top expand fill}
@@ -219,4 +220,20 @@ test textMark-8.8 {MarkFindPrev - no previous mark} {
 } {}
 
 catch {destroy .t}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/textTag.test b/tests/textTag.test
index 79901cf..0cfc840 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -3,19 +3,20 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: textTag.test,v 1.2 1998/09/14 18:23:52 stanton Exp $
+# RCS: @(#) $Id: textTag.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 catch {destroy .t}
 if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
     puts "The font needed by these tests isn't available, so I'm"
     puts "going to skip the tests."
+    ::tcltest::cleanupTests
     return
 }
 pack append . .t {top expand fill}
@@ -183,7 +184,14 @@ test textTag-3.7 {TkTextTagCmd - "bind" option} {
     .t tag bind x <Enter>
 } {script1
 script2}
-
+test textTag-3.7 {TkTextTagCmd - "bind" option} {
+    .t tag delete x
+    list [catch {.t tag bind x <Enter>} msg] $msg
+} {0 {}}
+test textTag-3.8 {TkTextTagCmd - "bind" option} {
+    .t tag delete x
+    list [catch {.t tag bind x <} msg] $msg
+} {1 {no event type or button # or keysym}}
 
 test textTag-4.1 {TkTextTagCmd - "cget" option} {
     list [catch {.t tag cget a} msg] $msg
@@ -753,4 +761,20 @@ test textTag-16.7 {TkTextPickCurrent procedure} {
 } {3.1}
 
 catch {destroy .t}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/textWind.test b/tests/textWind.test
index a62663d..4e11955 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -3,14 +3,14 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: textWind.test,v 1.2 1998/09/14 18:23:52 stanton Exp $
+# RCS: @(#) $Id: textWind.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 foreach i [winfo child  .] {
     catch {destroy $i}
@@ -824,3 +824,20 @@ pack .t
 
 catch {destroy .t}
 option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/tk.test b/tests/tk.test
index 89a853b..c62832c 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -2,14 +2,13 @@
 # It is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: tk.test,v 1.2 1998/09/14 18:23:52 stanton Exp $
+# RCS: @(#) $Id: tk.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
 
-if {[info commands test] == ""} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 test tk-1.1 {tk command: general} {
@@ -17,7 +16,7 @@ test tk-1.1 {tk command: general} {
 } {1 {wrong # args: should be "tk option ?arg?"}}
 test tk-1.2 {tk command: general} {
     list [catch {tk xyz} msg] $msg
-} {1 {bad option "xyz": must be appname, or scaling}}
+} {1 {bad option "xyz": must be appname or scaling}}
 
 set appname [tk appname]
 test tk-2.1 {tk command: appname} {
@@ -78,3 +77,20 @@ test tk-3.11 {tk command: scaling: heightmm} {
     expr {int((25.4*[winfo screenheight .])/(72*1.25)+0.5)-[winfo screenmmheight .]}
 } {0}
 tk scaling $scaling
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixButton.test b/tests/unixButton.test
index 6788655..6604e36 100644
--- a/tests/unixButton.test
+++ b/tests/unixButton.test
@@ -5,13 +5,18 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixButton.test,v 1.2 1998/09/14 18:23:52 stanton Exp $
+# RCS: @(#) $Id: unixButton.test,v 1.3 1999/04/16 01:51:41 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {$tcl_platform(platform)!="unix"} {
+    puts "skipping: Unix only tests..."
+    ::tcltest::cleanupTests
     return
 }
 
@@ -19,13 +24,10 @@ if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\""
     puts "image, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 foreach i [winfo children .] {
     destroy $i
 }
@@ -180,3 +182,20 @@ test unixbutton-1.11 {TkpComputeButtonGeometry procedure} {
 } {27 37}
 
 eval destroy [winfo children .]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test
index 39a3cf5..2f2970d 100644
--- a/tests/unixEmbed.test
+++ b/tests/unixEmbed.test
@@ -3,18 +3,19 @@
 # tests.
 #
 # Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixEmbed.test,v 1.4 1998/12/08 04:05:34 hershey Exp $
+# RCS: @(#) $Id: unixEmbed.test,v 1.5 1999/04/16 01:51:41 stanton Exp $
 
-if {$tcl_platform(platform) != "unix"} {
-    return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
-if {[info procs test] != "test"} {
-    source defs
+if {$tcl_platform(platform) != "unix"} {
+    puts "skipping: Unix only tests..."
+    ::tcltest::cleanupTests
+    return
 }
 
 eval destroy [winfo children .]
@@ -72,7 +73,7 @@ test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
     catch {destroy .t}
     list [catch {toplevel .t -use 47} msg] $msg
 } {1 {couldn't create child of window "47"}}
-test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {
+test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {nonPortable} {
     catch {destroy .t}
     catch {destroy .x}
     toplevel .t -colormap new
@@ -84,7 +85,7 @@ test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {
     destroy .t
     set result
 } {0}
-test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {
+test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {nonPortable} {
     catch {destroy .t}
     catch {destroy .t2}
     catch {destroy .x}
@@ -101,6 +102,7 @@ if {[string compare testembed [info commands testembed]] != 0} {
     puts "This application hasn't been compiled with the testembed command,"
     puts "therefore I am skipping all of these tests."
     cleanupbg
+    ::tcltest::cleanupTests
     return
 }
 
@@ -621,8 +623,23 @@ test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
     wm geometry .t1
 } {70x300+0+0}
 
-
+# cleanup
 foreach w [winfo child .] {
     catch {destroy $w}
 }
 cleanupbg
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixFont.test b/tests/unixFont.test
index 9dcd672..896eda9 100644
--- a/tests/unixFont.test
+++ b/tests/unixFont.test
@@ -9,18 +9,19 @@
 # at all sites.  
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixFont.test,v 1.2 1998/09/14 18:23:52 stanton Exp $
+# RCS: @(#) $Id: unixFont.test,v 1.3 1999/04/16 01:51:42 stanton Exp $
 
-if {$tcl_platform(platform)!="unix"} {
-    return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
-if {[string compare test [info procs test]] != 0} {
-    source defs
+if {$tcl_platform(platform)!="unix"} {
+    puts "skipping: Unix only tests..."
+    ::tcltest::cleanupTests
+    return
 }
 
 catch {destroy .b}
@@ -222,23 +223,25 @@ test unixfont-8.1 {AllocFont procedure: use old font} {
     font delete xyz
 } {}
 test unixfont-8.2 {AllocFont procedure: parse information from XLFD} {
-    expr [lindex [font actual {-family times -size 0}] 3]==0
+    expr {[lindex [font actual {-family times -size 0}] 3] == 0}
 } {0}
 test unixfont-8.3 {AllocFont procedure: can't parse info from name} {
-    if [catch {set a [font actual a12biluc]}]==0 {
-	string compare $a "-family a12biluc -size 0 -weight normal -slant roman -underline 0 -overstrike 0"
-    } else {
-	set a 0
-    }
-} {0}
+    catch {unset fontArray}
+    # check that font actual returns the correct attributes.
+    # the values of those attributes are system dependent.
+    array set fontArray [font actual a12biluc]
+    set result [lsort [array names fontArray]]
+    catch {unset fontArray}
+    set result
+} {-family -overstrike -size -slant -underline -weight}
 test unixfont-8.4 {AllocFont procedure: classify characters} {
     set x 0
-    incr x [font measure $courier "\001"]   ;# 4
+    incr x [font measure $courier "\u4000"]   ;# 6
     incr x [font measure $courier "\002"]   ;# 4
     incr x [font measure $courier "\012"]   ;# 2
     incr x [font measure $courier "\101"]   ;# 1
     set x
-} [expr $cx*11]
+} [expr $cx*13]
 test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} {
     font metrics $courier -fixed
 } {1}
@@ -281,7 +284,7 @@ test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} {
 } {0 1 1 2}
 test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {
     .b.c dchars $t 0 end
-    .b.c insert $t 0 "0\1770"
+    .b.c insert $t 0 "0\0010"
     set x {}
     lappend x [.b.c index $t @[expr $ax*0],0]
     lappend x [.b.c index $t @[expr $ax*1],0]
@@ -291,3 +294,19 @@ test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {
     lappend x [.b.c index $t @[expr $ax*5],0]
 } {0 1 1 1 1 2}
 
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixMenu.test b/tests/unixMenu.test
index cd1e87b..ebc833b 100644
--- a/tests/unixMenu.test
+++ b/tests/unixMenu.test
@@ -4,13 +4,18 @@
 # system.
 #
 # Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixMenu.test,v 1.2 1998/09/14 18:23:52 stanton Exp $
+# RCS: @(#) $Id: unixMenu.test,v 1.3 1999/04/16 01:51:42 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 if {$tcl_platform(platform) != "unix"} {
+    puts "skipping: Unix only tests..."
+    ::tcltest::cleanupTests
     return
 }
 
@@ -18,13 +23,10 @@ if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 proc deleteWindows {} {
     foreach i [winfo children .] {
     	catch [destroy $i]
@@ -332,8 +334,8 @@ test unixMenu-18.1 {GetTearoffEntryGeometry} {
     .mb.m add command -label test
     pack .mb
     raise .
-    list [catch {tkMbPost .mb} msg] $msg [destroy .mb]
-} {0 {} {}}
+    list [catch {tkMbPost .mb} msg] $msg [tkMenuUnpost .mb.m] [destroy .mb]
+} {0 {} {} {}}
 
 # Don't know how to reproduce the case where the tkwin has been deleted.
 test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} {
@@ -848,8 +850,8 @@ test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
     .mb.m add command -label test
     pack .mb
     catch {tkMbPost .mb}
-    list [update] [destroy .mb]
-} {{} {}}
+    list [update] [tkMenuUnpost .mb.m] [destroy .mb]
+} {{} {} {}}
 test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} {
     catch {destroy .m1}
     menu .m1
@@ -966,4 +968,20 @@ test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} {
 
 test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {}
 
+# cleanup
 deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixSend.test b/tests/unixSend.test
new file mode 100644
index 0000000..5914dd7
--- /dev/null
+++ b/tests/unixSend.test
@@ -0,0 +1,679 @@
+# This file is a Tcl script to test out the "send" command and the
+# other procedures in the file tkSend.c.  It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: unixSend.test,v 1.2 1999/04/16 01:51:42 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {$tcl_platform(platform) == "macintosh"} {
+    puts "send is not available on the Mac - skipping tests"
+    ::tcltest::cleanupTests
+    return
+}
+if {$tcl_platform(platform) == "windows"} {
+    puts "skipping: Unix only tests..."
+    ::tcltest::cleanupTests
+    return
+}
+if {[auto_execok xhost] == ""} {
+    puts "xhost application isn't available - skipping tests"
+    ::tcltest::cleanupTests
+    return
+}
+
+if {[info commands testsend] == "testsend"} {
+    set gotTestCmds 1
+} else {
+    set gotTestCmds 0
+}
+
+foreach i [winfo children .] {
+    destroy $i
+}
+wm geometry . {}
+raise .
+
+# If send is disabled because of inadequate security, don't run any
+# of these tests at all.
+
+setupbg
+set app [dobg {tk appname}]
+if {[catch {send $app set a 0} msg] == 1} {
+    if [string match "X server insecure *" $msg] {
+	puts -nonewline "Your X server is insecure, so \"send\" can't be used;"
+	puts " skipping \"send\" tests."
+	cleanupbg
+	::tcltest::cleanupTests
+	return
+    }
+}
+cleanupbg
+
+# Compute a script that will load Tk into a child interpreter.
+
+foreach pkg [info loaded] {
+    if {[lindex $pkg 1] == "Tk"} {
+	set loadTk "load $pkg"
+	break
+    }
+}
+
+# Procedure to create a new application with a given name and class.
+
+proc newApp {screen name class} {
+    global loadTk
+    interp create $name
+    $name eval [list set argv [list -display $screen -name $name -class $class]]
+    eval $loadTk $name
+}
+
+set name [tk appname]
+if $gotTestCmds {
+    set registry [testsend prop root InterpRegistry]
+    set commId [lindex [testsend prop root InterpRegistry] 0]
+}
+tk appname tktest
+catch {send t_s_1 destroy .}
+catch {send t_s_2 destroy .}
+
+if $gotTestCmds {
+    test unixSend-1.1 {RegOpen procedure, bogus property} {
+	testsend bogus
+	set result [winfo interps]
+	tk appname tktest
+	list $result [winfo interps]
+    } {{} tktest}
+    test unixSend-1.2 {RegOpen procedure, bogus property} {
+	testsend prop root InterpRegistry {}
+	set result [winfo interps]
+	tk appname tktest
+	list $result [winfo interps]
+    } {{} tktest}
+    test unixSend-1.3 {RegOpen procedure, bogus property} {
+	testsend prop root InterpRegistry abcdefg
+	tk appname tktest
+	set x [testsend prop root InterpRegistry]
+	string range $x [string first " " $x] end
+    } " tktest\nabcdefg\n"
+
+    frame .f -width 1 -height 1
+    set id [string range [winfo id .f] 2 end]
+    test unixSend-2.1 {RegFindName procedure} {
+	testsend prop root InterpRegistry {}
+	list [catch {send foo bar} msg] $msg
+    } {1 {no application named "foo"}}
+    test unixSend-2.2 {RegFindName procedure} {
+	testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n"
+	tk appname foo
+    } {foo #2}
+    test unixSend-2.3 {RegFindName procedure} {
+	testsend prop root InterpRegistry "gyz foo\n"
+	tk appname foo
+    } {foo}
+    test unixSend-2.4 {RegFindName procedure} {
+	testsend prop root InterpRegistry "${id}z foo\n"
+	tk appname foo
+    } {foo}
+
+    test unixSend-3.1 {RegDeleteName procedure} {
+	tk appname tktest
+	testsend prop root InterpRegistry "012345 gorp\n12345 foo\n12345 tktest"
+	tk appname x
+	set x [testsend prop root InterpRegistry]
+	string range $x [string first " " $x] end
+    } " x\n012345 gorp\n12345 foo\n"
+    test unixSend-3.2 {RegDeleteName procedure} {
+	tk appname tktest
+	testsend prop root InterpRegistry "012345 gorp\n12345 tktest\n23456 tktest"
+	tk appname x
+	set x [testsend prop root InterpRegistry]
+	string range $x [string first " " $x] end
+    } " x\n012345 gorp\n23456 tktest\n"
+    test unixSend-3.3 {RegDeleteName procedure} {
+	tk appname tktest
+	testsend prop root InterpRegistry "012345 tktest\n12345 bar\n23456 tktest"
+	tk appname x
+	set x [testsend prop root InterpRegistry]
+	string range $x [string first " " $x] end
+    } " x\n12345 bar\n23456 tktest\n"
+    test unixSend-3.4 {RegDeleteName procedure} {
+	tk appname tktest
+	testsend prop root InterpRegistry "foo"
+	tk appname x
+	set x [testsend prop root InterpRegistry]
+	string range $x [string first " " $x] end
+    } " x\nfoo\n"
+    test unixSend-3.5 {RegDeleteName procedure} {
+	tk appname tktest
+	testsend prop root InterpRegistry ""
+	tk appname x
+	set x [testsend prop root InterpRegistry]
+	string range $x [string first " " $x] end
+    } " x\n"
+
+    test unixSend-4.1 {RegAddName procedure} {
+	testsend prop root InterpRegistry ""
+	tk appname bar
+	testsend prop root InterpRegistry
+    } "$commId bar\n"
+    test unixSend-4.2 {RegAddName procedure} {
+	testsend prop root InterpRegistry "abc def"
+	tk appname bar
+	tk appname foo
+	testsend prop root InterpRegistry
+    } "$commId foo\nabc def\n"
+
+    # Previous checks should already cover the Regclose procedure.
+
+    test unixSend-5.1 {ValidateName procedure} {
+	testsend prop root InterpRegistry "123 abc\n"
+	winfo interps
+    } {}
+    test unixSend-5.2 {ValidateName procedure} {
+	testsend prop root InterpRegistry "$id Hi there"
+	winfo interps
+    } {{Hi there}}
+    test unixSend-5.3 {ValidateName procedure} {
+	testsend prop root InterpRegistry "$id Bogus"
+	list [catch {send Bogus set a 44} msg] $msg
+    } {1 {target application died or uses a Tk version before 4.0}}
+    test unixSend-5.4 {ValidateName procedure} {
+	tk appname test
+	testsend prop root InterpRegistry "$commId Bogus\n$commId test\n"
+	winfo interps
+    } {test}
+}
+
+winfo interps
+tk appname tktest
+update
+setupbg
+set x [split [exec xhost] \n]
+foreach i [lrange $x 1 end]  {
+    exec xhost - $i
+}
+test unixSend-6.1 {ServerSecure procedure} {nonPortable} {
+    set a 44
+    list [dobg [list send [tk appname] set a 55]] $a
+} {55 55}
+test unixSend-6.2 {ServerSecure procedure} {nonPortable} {
+    set a 22
+    exec xhost [exec hostname]
+    list [catch {dobg [list send [tk appname] set a 33]} msg] $a $msg
+} {0 22 {X server insecure (must use xauth-style authorization); command ignored}}
+test unixSend-6.3 {ServerSecure procedure} {nonPortable} {
+    set a abc
+    exec xhost - [exec hostname]
+    list [dobg [list send [tk appname] set a new]] $a
+} {new new}
+cleanupbg
+
+if $gotTestCmds {
+    test unixSend-7.1 {Tk_SetAppName procedure} {
+	testsend prop root InterpRegistry ""
+	tk appname newName
+	list [tk appname oldName] [testsend prop root InterpRegistry]
+    } "oldName {$commId oldName\n}"
+    test unixSend-7.2 {Tk_SetAppName procedure, name not in use} {
+	testsend prop root InterpRegistry ""
+	list [tk appname gorp] [testsend prop root InterpRegistry]
+    } "gorp {$commId gorp\n}"
+    test unixSend-7.3 {Tk_SetAppName procedure, name in use by us} {
+	tk appname name1
+	testsend prop root InterpRegistry "$commId name2\n"
+	list [tk appname name2] [testsend prop root InterpRegistry]
+    } "name2 {$commId name2\n}"
+    test unixSend-7.4 {Tk_SetAppName procedure, name in use} {
+	tk appname name1
+	testsend prop root InterpRegistry "$id foo\n$id foo #2\n$id foo #3\n"
+	list [tk appname foo] [testsend prop root InterpRegistry]
+    } "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}"
+}
+
+test unixSend-8.1 {Tk_SendCmd procedure, options} {
+    setupbg
+    set app [dobg {tk appname}]
+    set a 66
+    send -async $app [list send [tk appname] set a 77]
+    set result $a
+    after 200 set x 40
+    tkwait variable x
+    cleanupbg
+    lappend result $a
+} {66 77}
+if [info exists env(TK_ALT_DISPLAY)] {
+    test unixSend-8.2 {Tk_SendCmd procedure, options} {
+	setupbg -display $env(TK_ALT_DISPLAY)
+	tk appname xyzgorp
+	set a homeDisplay
+	set result [dobg "
+	    toplevel .t -screen [winfo screen .]
+	    wm geometry .t +0+0
+	    set a altDisplay
+	    tk appname xyzgorp
+	    list \[send xyzgorp set a\] \[send -displayof .t xyzgorp set a\]
+	"]
+	cleanupbg
+	set result
+    } {altDisplay homeDisplay}
+}
+test unixSend-8.3 {Tk_SendCmd procedure, options} {
+    list [catch {send -- -async foo bar baz} msg] $msg
+} {1 {no application named "-async"}}
+test unixSend-8.4 {Tk_SendCmd procedure, options} {
+    list [catch {send -gorp foo bar baz} msg] $msg
+} {1 {bad option "-gorp": must be -async, -displayof, or --}}
+test unixSend-8.5 {Tk_SendCmd procedure, options} {
+    list [catch {send -async foo} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test unixSend-8.6 {Tk_SendCmd procedure, options} {
+    list [catch {send foo} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test unixSend-8.7 {Tk_SendCmd procedure, local execution} {
+    set a initial
+    send [tk appname] {set a new}
+    set a
+} {new}
+test unixSend-8.8 {Tk_SendCmd procedure, local execution} {
+    set a initial
+    send [tk appname] set a new
+    set a
+} {new}
+test unixSend-8.9 {Tk_SendCmd procedure, local execution} {
+    set a initial
+    string tolower [list [catch {send [tk appname] open bad_file} msg] \
+	    $msg $errorInfo $errorCode]
+} {1 {couldn't open "bad_file": no such file or directory} {couldn't open "bad_file": no such file or directory
+    while executing
+"open bad_file"
+    invoked from within
+"send [tk appname] open bad_file"} {posix enoent {no such file or directory}}}
+test unixSend-8.10 {Tk_SendCmd procedure, no such interpreter} {
+    list [catch {send bogus_name bogus_command} msg] $msg
+} {1 {no application named "bogus_name"}}
+if $gotTestCmds {
+    newApp "" t_s_1 Test
+    t_s_1 eval wm withdraw .
+    test unixSend-8.11 {Tk_SendCmd procedure, local execution, different interp} {
+	set a us
+	send t_s_1 set a them
+	list $a [send t_s_1 set a]
+    } {us them}
+    test unixSend-8.12 {Tk_SendCmd procedure, local execution, different interp} {
+	set a us
+	send t_s_1 {set a them}
+	list $a [send t_s_1 {set a}]
+    } {us them}
+    test unixSend-8.13 {Tk_SendCmd procedure, local execution, different interp} {
+	set a us
+	send t_s_1 {set a them}
+	list $a [send t_s_1 {set a}]
+    } {us them}
+    test unixSend-8.14 {Tk_SendCmd procedure, local interp killed by send} {
+	newApp "" t_s_2 Test
+	list [catch {send t_s_2 {destroy .; concat result}} msg] $msg
+    } {0 result}
+    interp delete t_s_2
+    test unixSend-8.15 {Tk_SendCmd procedure, local interp, error info} {
+	catch {error foo}
+	list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
+    } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory
+    while executing
+"open bogus_file_name"
+    invoked from within
+"if 1 {open bogus_file_name}"
+    invoked from within
+"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
+    test unixSend-8.16 {Tk_SendCmd procedure, bogusCommWindow} {
+	testsend prop root InterpRegistry "10234 bogus\n"
+	set result [list [catch {send bogus bogus command} msg] $msg]
+	winfo interps
+	tk appname tktest
+	set result
+    } {1 {no application named "bogus"}}
+    interp delete t_s_1
+}
+test unixSend-8.17 {Tk_SendCmd procedure, deferring events} {nonPortable} {
+    # Non-portable because some window managers ignore "raise"
+    # requests so can't guarantee that new app's window won't
+    # obscure .f, thereby masking the Expose event.
+
+    setupbg
+    set app [dobg {tk appname}]
+    raise .		; # Don't want new app obscuring .f
+    catch {destroy .f}
+    frame .f
+    place .f -x 0 -y 0
+    bind .f <Expose> {set a exposed}
+    set a {no event yet}
+    set result ""
+    lappend result [send $app send [list [tk appname]] set a]
+    lappend result $a
+    update
+    cleanupbg
+    lappend result $a
+} {{no event yet} {no event yet} exposed}
+test unixSend-8.18 {Tk_SendCmd procedure, error in remote app} {
+    setupbg
+    set app [dobg {tk appname}]
+    set result [string tolower [list [catch {send $app open bad_name} msg] \
+	    $msg $errorInfo $errorCode]]
+    cleanupbg
+    set result
+} {1 {couldn't open "bad_name": no such file or directory} {couldn't open "bad_name": no such file or directory
+    while executing
+"open bad_name"
+    invoked from within
+"send $app open bad_name"} {posix enoent {no such file or directory}}}
+test unixSend-8.19 {Tk_SendCmd, using modal timeouts} {
+    setupbg
+    set app [dobg {tk appname}]
+    set x no
+    set result ""
+    after 0 {set x yes}
+    lappend result [send $app {concat x y z}]
+    lappend result $x
+    update
+    cleanupbg
+    lappend result $x
+} {{x y z} no yes}
+
+tk appname tktest
+catch {destroy .f}
+frame .f
+set id [string range [winfo id .f] 2 end]
+if $gotTestCmds {
+    test unixSend-9.1 {Tk_GetInterpNames procedure} {
+	testsend prop root InterpRegistry \
+		"$commId tktest\nfoo bar\n$commId tktest\n$id frame .f\n\n\n"
+	list [winfo interps] [testsend prop root InterpRegistry]
+    } "{tktest tktest {frame .f}} {$commId tktest\n$commId tktest\n$id frame .f
+}"
+    test unixSend-9.2 {Tk_GetInterpNames procedure} {
+	testsend prop root InterpRegistry \
+		"$commId tktest\nfoobar\n$commId gorp\n"
+	list [winfo interps] [testsend prop root InterpRegistry]
+    } "tktest {$commId tktest\n}"
+    test unixSend-9.3 {Tk_GetInterpNames procedure} {
+	testsend prop root InterpRegistry {}
+	list [winfo interps] [testsend prop root InterpRegistry]
+    } {{} {}}
+
+    testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"
+    test unixSend-10.1 {SendEventProc procedure, bogus comm property} {
+	testsend prop comm Comm {abc def}
+	testsend prop comm Comm {}
+	update
+    } {}
+    test unixSend-10.2 {SendEventProc procedure, simultaneous messages} {
+	testsend prop comm Comm \
+		"c\n-n tktest\n-s set a 44\nc\n-n tktest\n-s set b 45\n"
+	set a null
+	set b xyzzy
+	update
+	list $a $b
+    } {44 45}
+    test unixSend-10.3 {SendEventProc procedure, simultaneous messages} {
+	testsend prop comm Comm \
+		"c\n-n tktest\n-s set a newA\nr\n-s [testsend serial]\n-r 12345\nc\n-n tktest\n-s set b newB\n"
+	set a null
+	set b xyzzy
+	set x [send dummy bogus]
+	list $x $a $b
+    } {12345 newA newB}
+    test unixSend-10.4 {SendEventProc procedure, leading nulls, bogus commands} {
+	testsend prop comm Comm \
+		"\n\nx\n-bogus\n\nc\n-n tktest\n-s set a 44\n"
+	set a null
+	update
+	set a
+    } {44}
+    test unixSend-10.5 {SendEventProc procedure, extraneous command options} {
+	testsend prop comm Comm \
+		"c\n-n tktest\n-x miscellanous\n-y who knows?\n-s set a new\n"
+	set a null
+	update
+	set a
+    } {new}
+    test unixSend-10.6 {SendEventProc procedure, unknown interpreter} {
+	testsend prop [winfo id .f] Comm {}
+	testsend prop comm Comm \
+		"c\n-n unknown\n-r $id 44\n-s set a new\n"
+	set a null
+	update
+	list [testsend prop [winfo id .f] Comm] $a
+    } "{\nr\n-s 44\n-r receiver never heard of interpreter \"unknown\"\n-c 1\n} null"
+    test unixSend-10.7 {SendEventProc procedure, error in script} {
+	testsend prop [winfo id .f] Comm {}
+	testsend prop comm Comm \
+		"c\n-n tktest\n-r $id 62\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
+	update
+	testsend prop [winfo id .f] Comm
+    } {
+r
+-s 62
+-r test error
+-i Initial errorInfo
+    ("foreach" body line 1)
+    invoked from within
+"foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}"
+-e test code
+-c 1
+}
+    test unixSend-10.8 {SendEventProc procedure, exceptional return} {
+	testsend prop [winfo id .f] Comm {}
+	testsend prop comm Comm \
+		"c\n-n tktest\n-r $id 62\n-s break\n"
+	update
+	testsend prop [winfo id .f] Comm
+    } {
+r
+-s 62
+-r 
+-c 3
+}
+    test unixSend-10.9 {SendEventProc procedure, empty return} {
+	testsend prop [winfo id .f] Comm {}
+	testsend prop comm Comm \
+		"c\n-n tktest\n-r $id 62\n-s concat\n"
+	update
+	testsend prop [winfo id .f] Comm
+    } {
+r
+-s 62
+-r 
+}
+    test unixSend-10.10 {SendEventProc procedure, asynchronous calls} {
+	testsend prop [winfo id .f] Comm {}
+	testsend prop comm Comm \
+		"c\n-n tktest\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
+	update
+	testsend prop [winfo id .f] Comm
+    } {}
+    test unixSend-10.11 {SendEventProc procedure, exceptional return} {
+	testsend prop [winfo id .f] Comm {}
+	testsend prop comm Comm \
+		"c\n-n tktest\n-s break\n"
+	update
+	testsend prop [winfo id .f] Comm
+    } {}
+    test unixSend-10.12 {SendEventProc procedure, empty return} {
+	testsend prop [winfo id .f] Comm {}
+	testsend prop comm Comm \
+		"c\n-n tktest\n-s concat\n"
+	update
+	testsend prop [winfo id .f] Comm
+    } {}
+    test unixSend-10.13 {SendEventProc procedure, return processing} {
+	testsend prop comm Comm \
+		"r\n-c 1\n-e test1\n-i test2\n-r test3\n-s [testsend serial]\n"
+	list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
+    } {1 test3 {test2
+    invoked from within
+"send dummy foo"} test1}
+    test unixSend-10.14 {SendEventProc procedure, extraneous return options} {
+	testsend prop comm Comm \
+		"r\n-x test1\n-y test2\n-r result\n-s [testsend serial]\n"
+	list [catch {send dummy foo} msg] $msg
+    } {0 result}
+    test unixSend-10.15 {SendEventProc procedure, serial number} {
+	testsend prop comm Comm \
+		"r\n-r response\n"
+	list [catch {send dummy foo} msg] $msg
+    } {1 {target application died or uses a Tk version before 4.0}}
+    test unixSend-10.16 {SendEventProc procedure, serial number} {
+	testsend prop comm Comm \
+		"r\n-r response\n\n-s 0"
+	list [catch {send dummy foo} msg] $msg
+    } {1 {target application died or uses a Tk version before 4.0}}
+    test unixSend-10.17 {SendEventProc procedure, errorCode and errorInfo} {
+	testsend prop comm Comm \
+		"r\n-i test1\n-e test2\n-c 4\n-s [testsend serial]\n"
+	set errorCode oldErrorCode
+	set errorInfo oldErrorInfo
+	list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
+    } {4 {} oldErrorInfo oldErrorCode}
+    test unixSend-10.18 {SendEventProc procedure, send kills application} {
+	setupbg
+	dobg {tk appname t_s_3}
+	set x [list [catch {send t_s_3 destroy .} msg] $msg]
+	cleanupbg
+	set x
+    } {0 {}}
+    test unixSend-10.19 {SendEventProc procedure, send exits} {
+	setupbg
+	dobg {tk appname t_s_3}
+	set x [list [catch {send t_s_3 exit} msg] $msg]
+	close $::tcltest::fd
+	set x
+    } {1 {target application died}}
+
+    test unixSend-11.1 {AppendPropCarefully and AppendErrorProc procedures} {
+	testsend prop root InterpRegistry "0x21447 dummy\n"
+	list [catch {send dummy foo} msg] $msg
+    } {1 {no application named "dummy"}}
+    test unixSend-11.2 {AppendPropCarefully and AppendErrorProc procedures} {
+	testsend prop comm Comm "c\n-r0x123 44\n-n tktest\n-s concat a b c\n"
+	update
+    } {}
+}
+
+winfo interps
+tk appname tktest
+catch {destroy .f}
+frame .f
+set id [string range [winfo id .f] 2 end]
+if $gotTestCmds {
+    test unixSend-12.1 {TimeoutProc procedure} {
+        testsend prop root InterpRegistry "$id dummy\n"
+        list [catch {send dummy foo} msg] $msg
+    } {1 {target application died or uses a Tk version before 4.0}}
+    testsend prop root InterpRegistry ""
+}
+test unixSend-12.2 {TimeoutProc procedure} {
+    winfo interps
+    tk appname tktest
+    update
+    setupbg
+    puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
+    set ::tcltest::bgDone 0
+    set ::tcltest::bgData {}
+    flush $::tcltest::fd
+    tkwait variable ::tcltest::bgDone
+    set app $::tcltest::bgData
+    after 200
+    set result [list [catch {send $app foo} msg] $msg]
+    close $::tcltest::fd
+    set result
+} {1 {target application died}}
+
+winfo interps
+tk appname tktest
+test unixSend-13.1 {DeleteProc procedure} {
+    setupbg
+    set app [dobg {rename send {}; tk appname}]
+    set result [list [catch {send $app foo} msg] $msg [winfo interps]]
+    cleanupbg
+    set result
+} {1 {no application named "tktest #2"} tktest}
+test unixSend-13.2 {DeleteProc procedure} {
+    winfo interps
+    tk appname tktest
+    rename send {}
+    set result {}
+    lappend result [winfo interps] [info commands send]
+    tk appname foo
+    lappend result [winfo interps] [info commands send]
+} {{} {} foo send}
+
+if [info exists env(TK_ALT_DISPLAY)] {
+    test unixSend-14.1 {SendRestrictProc procedure, sends crossing from different displays} {
+	setupbg -display $env(TK_ALT_DISPLAY)
+	set result [dobg "
+	    toplevel .t -screen [winfo screen .]
+	    wm geometry .t +0+0
+	    tk appname xyzgorp1
+	    set x child
+	"]
+	toplevel .t -screen $env(TK_ALT_DISPLAY)
+	wm geometry .t +0+0
+	tk appname xyzgorp2
+	update
+	set y parent
+	set result [send -displayof .t xyzgorp1 {list $x [send -displayof .t xyzgorp2 set y]}]
+	destroy .t
+	cleanupbg
+	set result
+    } {child parent}
+}
+
+if $gotTestCmds {
+    testsend prop root InterpRegister $registry
+    tk appname tktest
+    test unixSend-15.1 {UpdateCommWindow procedure} {
+	set x [list [testsend prop comm TK_APPLICATION]]
+	newApp "" t_s_1 Test
+	send t_s_1 wm withdraw .
+	newApp "" t_s_2 Test
+	send t_s_2 wm withdraw .
+	lappend x [testsend prop comm TK_APPLICATION]
+	interp delete t_s_1
+	lappend x [testsend prop comm TK_APPLICATION]
+	interp delete t_s_2
+	lappend x [testsend prop comm TK_APPLICATION]
+    } {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest}
+}
+
+tk appname $name
+if $gotTestCmds {
+    testsend prop root InterpRegistry $registry
+}
+if $gotTestCmds {
+    testdeleteapps
+}
+rename newApp {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixWm.test b/tests/unixWm.test
index f70c589..11528d6 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -4,18 +4,19 @@
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixWm.test,v 1.4 1999/02/04 21:03:28 stanton Exp $
+# RCS: @(#) $Id: unixWm.test,v 1.5 1999/04/16 01:51:42 stanton Exp $
 
-if {$tcl_platform(platform) != "unix"} {
-    return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
+if {$tcl_platform(platform) != "unix"} {
+    puts "skipping: Unix only tests..."
+    ::tcltest::cleanupTests
+    return
 }
 
 proc sleep ms {
@@ -195,7 +196,7 @@ test unixWm-6.3 {size changes} {
     update
     wm geom .t
 } 170x140+10+10
-test unixWm-6.4 {size changes} {nonPortable} {
+test unixWm-6.4 {size changes} {nonPortable userInteraction} {
     wm minsize .t 1 1
     update
     puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
@@ -355,6 +356,7 @@ test unixWm-8.9 {icon windows} {nonPortable} {
 if {[string compare testwrapper [info commands testwrapper]] != 0} {
     puts "This application hasn't been compiled with the testwrapper command,"
     puts "therefore I am skipping all of these tests."
+    ::tcltest::cleanupTests
     return
 }
 
@@ -1309,7 +1311,7 @@ test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} {
     sleep 500
     lappend result [winfo width .t] [winfo height .t]
 } {400 150 200 300}
-test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} {
+test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable} {
     catch {destroy .t}
     toplevel .t -width 300 -height 200 -bd 2 -relief raised
     wm geom .t +0+0
@@ -1473,22 +1475,26 @@ test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} {
     update
     list [winfo width .t] [winfo height .t]
 } {100 1}
+
+catch {destroy .t}
+toplevel .t -width 80 -height 60
 test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {
-    catch {destroy .t}
-    toplevel .t -width 80 -height 60
     wm geometry .t +5-10
     wm overrideredirect .t 1
     tkwait visibility .t
     list [winfo x .t] [winfo y .t]
-} "5 [expr [winfo screenheight .t] - 70]"
+} [list 5 [expr [winfo screenheight .t] - 70]]
+
+catch {destroy .t}
+toplevel .t -width 80 -height 60
 test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
-    catch {destroy .t}
-    toplevel .t -width 80 -height 60
     wm geometry .t -30+2
     wm overrideredirect .t 1
     tkwait visibility .t
     list [winfo x .t] [winfo y .t]
-} "[expr [winfo screenwidth .t] - 110] 2"
+} [list [expr [winfo screenwidth .t] - 110] 2]
+catch {destroy .t}
+
 test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
     catch {destroy .t}
     toplevel .t -width 80 -height 60
@@ -2291,6 +2297,37 @@ test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} {
     lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
 } {0 20 0 1}
 
+test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unixOnly} {
+    catch {destroy .t}
+    toplevel .t -width 100 -height 50
+    wm geom .t +0+0
+    wm command .t "argumentNumber0 argumentNumber1 argumentNumber2 argumentNumber0 argumentNumber3 argumentNumber4 argumentNumber5 argumentNumber6 argumentNumber0 argumentNumber7 argumentNumber8 argumentNumber9 argumentNumber10 argumentNumber0 argumentNumber11 argumentNumber12 argumentNumber13 argumentNumber14 argumentNumber15 argumentNumber16 argumentNumber17 argumentNumber18"
+    update
+    testprop [testwrapper .t] WM_COMMAND
+} {argumentNumber0
+argumentNumber1
+argumentNumber2
+argumentNumber0
+argumentNumber3
+argumentNumber4
+argumentNumber5
+argumentNumber6
+argumentNumber0
+argumentNumber7
+argumentNumber8
+argumentNumber9
+argumentNumber10
+argumentNumber0
+argumentNumber11
+argumentNumber12
+argumentNumber13
+argumentNumber14
+argumentNumber15
+argumentNumber16
+argumentNumber17
+argumentNumber18
+}
+
 # Test exit processing and cleanup:
 
 test unixWm-58.1 {exit processing} {
@@ -2301,7 +2338,7 @@ test unixWm-58.1 {exit processing} {
 	exit
     }
     close $fd
-    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+    if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
 	set error 1
     } else {
 	set error 0
@@ -2320,7 +2357,7 @@ test unixWm-58.2 {exit processing} {
 	exit
     }
     close $fd
-    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+    if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
 	set error 1
     } else {
 	set error 0
@@ -2345,7 +2382,7 @@ test unixWm-58.3 {exit processing} {
 	exit
     }
     close $fd
-    if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+    if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
 	set error 1
     } else {
 	set error 0
@@ -2353,7 +2390,21 @@ test unixWm-58.3 {exit processing} {
     list $error $msg
 } {0 {}}
 
-    
+# cleanup
 catch {destroy .t}
 catch {removeFile script}
-concat {}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/util.test b/tests/util.test
index 9793144..d3d5c91 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -3,14 +3,14 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: util.test,v 1.2 1998/09/14 18:23:53 stanton Exp $
+# RCS: @(#) $Id: util.test,v 1.3 1999/04/16 01:51:42 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then \
-  {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 foreach i [winfo children .] {
     destroy $i
@@ -68,3 +68,20 @@ test util-1.11 {Tk_GetScrollInfo procedure} {
 test util-1.12 {Tk_GetScrollInfo procedure} {
     list [catch {.l yview dropdead 3 times} msg] $msg
 } {1 {unknown option "dropdead": must be moveto or scroll}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/visual b/tests/visual
deleted file mode 100644
index d227503..0000000
--- a/tests/visual
+++ /dev/null
@@ -1,81 +0,0 @@
-#!/usr/local/bin/wish -f
-#
-# This script displays provides visual tests for many of Tk's features.
-# Each test displays a window with various information in it, along
-# with instructions about how the window should appear.  You can look
-# at the window to make sure it appears as expected.  Individual tests
-# are kept in separate ".tcl" files in this directory.
-#
-# RCS: @(#) $Id: visual,v 1.2 1998/09/14 18:23:53 stanton Exp $
-
-set auto_path ". $auto_path"
-wm title . "Visual Tests for Tk"
-
-#-------------------------------------------------------
-# The code below create the main window, consisting of a
-# menu bar and a message explaining the basic operation
-# of the program.
-#-------------------------------------------------------
-
-frame .menu -relief raised -borderwidth 1
-message .msg -font {Times 18} -relief raised -width 4i \
-	-borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
-
-pack .menu -side top -fill x
-pack .msg -side bottom -expand yes -fill both
-
-#-------------------------------------------------------
-# The code below creates all the menus, which invoke procedures
-# to create particular demonstrations of various widgets.
-#-------------------------------------------------------
-
-menubutton .menu.file -text "File" -menu .menu.file.m
-menu .menu.file.m
-.menu.file.m add command -label "Quit" -command exit
-
-menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
-menu .menu.group1.m
-.menu.group1.m add command -label "Canvas arcs" -command {source arc.tcl}
-.menu.group1.m add command -label "Beveled borders in text widgets" \
-	-command {source bevel.tcl}
-.menu.group1.m add command -label "Colormap management" \
-	-command {source cmap.tcl}
-.menu.group1.m add command -label "Label/button geometry" \
-	-command {source butGeom.tcl}
-.menu.group1.m add command -label "Label/button colors" \
-	-command {source butGeom2.tcl}
-
-menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
-menu .menu.ps.m
-.menu.ps.m add command -label "Rectangles and other graphics" \
-	-command {source canvPsGrph.tcl}
-.menu.ps.m add command -label "Text" \
-	-command {source canvPsText.tcl}
-.menu.ps.m add command -label "Bitmaps" \
-	-command {source canvPsBmap.tcl}
-.menu.ps.m add command -label "Arcs" \
-	-command {source canvPsArc.tcl}
-
-pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
-
-# Set up for keyboard-based menu traversal
-
-bind . <Any-FocusIn> {
-    if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
-	focus .menu
-    }
-}
-tk_menuBar .menu .menu.file .menu.group1 .menu.ps
-
-# The following procedure is invoked to print the contents of a canvas:
-
-proc lpr c {
-    exec rm -f tmp.ps
-    $c postscript -file tmp.ps
-    exec lpr tmp.ps
-}
-
-# Set up a class binding to allow objects to be deleted from a canvas
-# by clicking with mouse button 1:
-
-bind Canvas <1> {%W delete [%W find closest %x %y]}
diff --git a/tests/visual.test b/tests/visual.test
index 402bd5c..8614c2d 100644
--- a/tests/visual.test
+++ b/tests/visual.test
@@ -4,14 +4,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: visual.test,v 1.2 1998/09/14 18:23:53 stanton Exp $
+# RCS: @(#) $Id: visual.test,v 1.3 1999/04/16 01:51:43 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -310,3 +309,20 @@ foreach w [winfo child .] {
 }
 rename eatColors {}
 rename colorsFree {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/visual_bb.test b/tests/visual_bb.test
new file mode 100644
index 0000000..efafc09
--- /dev/null
+++ b/tests/visual_bb.test
@@ -0,0 +1,109 @@
+#!/usr/local/bin/wish -f
+#
+# This script displays provides visual tests for many of Tk's features.
+# Each test displays a window with various information in it, along
+# with instructions about how the window should appear.  You can look
+# at the window to make sure it appears as expected.  Individual tests
+# are kept in separate ".tcl" files in this directory.
+#
+# RCS: @(#) $Id: visual_bb.test,v 1.2 1999/04/16 01:51:43 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+set auto_path ". $auto_path"
+wm title . "Visual Tests for Tk"
+
+set testNum 1
+
+# Each menu entry invokes a visual test file
+
+proc runTest {file} {
+    global testNum
+
+    test "2.$testNum" "testing $file" {userInteraction} {
+	uplevel \#0 source [file join $::tcltest::testsDir $file]
+	concat ""
+    } {}
+    incr testNum
+}
+
+# The following procedure is invoked to print the contents of a canvas:
+
+proc lpr c {
+    exec rm -f tmp.ps
+    $c postscript -file tmp.ps
+    exec lpr tmp.ps
+    exec rm -f tmp.ps
+}
+
+test 1.1 "running visual tests" {userInteraction} {
+
+    #-------------------------------------------------------
+    # The code below create the main window, consisting of a
+    # menu bar and a message explaining the basic operation
+    # of the program.
+    #-------------------------------------------------------
+
+    frame .menu -relief raised -borderwidth 1
+    message .msg -font {Times 18} -relief raised -width 4i \
+	    -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
+    
+    pack .menu -side top -fill x
+    pack .msg -side bottom -expand yes -fill both
+
+    #-------------------------------------------------------
+    # The code below creates all the menus, which invoke procedures
+    # to create particular demonstrations of various widgets.
+    #-------------------------------------------------------
+
+    menubutton .menu.file -text "File" -menu .menu.file.m
+    menu .menu.file.m
+    .menu.file.m add command -label "Quit" -command ::tcltest::cleanupTests
+    
+    menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
+    menu .menu.group1.m
+    .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl}
+    .menu.group1.m add command -label "Beveled borders in text widgets" \
+	    -command {runTest bevel.tcl}
+    .menu.group1.m add command -label "Colormap management" \
+	    -command {runTest cmap.tcl}
+    .menu.group1.m add command -label "Label/button geometry" \
+	    -command {runTest butGeom.tcl}
+    .menu.group1.m add command -label "Label/button colors" \
+	    -command {runTest butGeom2.tcl}
+    
+    menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
+    menu .menu.ps.m
+    .menu.ps.m add command -label "Rectangles and other graphics" \
+	    -command {runTest canvPsGrph.tcl}
+    .menu.ps.m add command -label "Text" \
+	    -command {runTest canvPsText.tcl}
+    .menu.ps.m add command -label "Bitmaps" \
+	    -command {runTest canvPsBmap.tcl}
+    .menu.ps.m add command -label "Arcs" \
+	    -command {runTest canvPsArc.tcl}
+    
+    pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
+    
+    # Set up for keyboard-based menu traversal
+    
+    bind . <Any-FocusIn> {
+	if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
+	    focus .menu
+	}
+    }
+    tk_menuBar .menu .menu.file .menu.group1 .menu.ps
+
+    # Set up a class binding to allow objects to be deleted from a canvas
+    # by clicking with mouse button 1:
+
+    bind Canvas <1> {%W delete [%W find closest %x %y]}
+
+    concat ""
+} {}
+
+if {!$::tcltest::testConfig(userInteraction)} {
+    ::tcltest::cleanupTests
+}
diff --git a/tests/winButton.test b/tests/winButton.test
index 4202a6a..48a60d5 100644
--- a/tests/winButton.test
+++ b/tests/winButton.test
@@ -5,27 +5,23 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winButton.test,v 1.3 1998/09/14 18:23:53 stanton Exp $
+# RCS: @(#) $Id: winButton.test,v 1.4 1999/04/16 01:51:43 stanton Exp $
 
-if {$tcl_platform(platform)!="windows"} {
-    return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\""
     puts "image, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 foreach i [winfo children .] {
     destroy $i
 }
@@ -47,7 +43,7 @@ radiobutton .r -text Radiobutton
 pack .l .b .c .r
 update
 
-test winbutton-1.1 {TkpComputeButtonGeometry procedure} {
+test winbutton-1.1 {TkpComputeButtonGeometry procedure} {pcOnly} {
     eval destroy [winfo children .]
     image create test image1
     image1 changed 0 0 0 0 60 40
@@ -62,7 +58,7 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} {
 	    [winfo reqwidth .b3] [winfo reqheight .b3] \
 	    [winfo reqwidth .b4] [winfo reqheight .b4]
 } {68 48 71 51 96 50 96 50}
-test winbutton-1.2 {TkpComputeButtonGeometry procedure} {
+test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} {
     eval destroy [winfo children .]
     label .b1 -bitmap question -bd 3 -padx 0 -pady 2
     button .b2 -bitmap question -bd 3 -padx 0 -pady 2
@@ -75,7 +71,7 @@ test winbutton-1.2 {TkpComputeButtonGeometry procedure} {
 	    [winfo reqwidth .b3] [winfo reqheight .b3] \
 	    [winfo reqwidth .b4] [winfo reqheight .b4]
 } {23 33 26 36 51 35 51 35}
-test winbutton-1.3 {TkpComputeButtonGeometry procedure} {
+test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} {
     eval destroy [winfo children .]
     label .b1 -bitmap question -bd 3 -highlightthickness 4
     button .b2 -bitmap question -bd 3 -highlightthickness 0
@@ -89,7 +85,7 @@ test winbutton-1.3 {TkpComputeButtonGeometry procedure} {
 	    [winfo reqwidth .b3] [winfo reqheight .b3] \
 	    [winfo reqwidth .b4] [winfo reqheight .b4]
 } {31 41 24 34 26 36 26 36}
-test winbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
     eval destroy [winfo children .]
     label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
     button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
@@ -102,21 +98,21 @@ test winbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable} {
 	    [winfo reqwidth .b3] [winfo reqheight .b3] \
 	    [winfo reqwidth .b4] [winfo reqheight .b4]
 } {58 24 67 33 88 30 90 28} 
-test winbutton-1.5 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.5 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
     eval destroy [winfo children .]
     label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0
     pack .l1
     update
     list [winfo reqwidth .l1] [winfo reqheight .l1]
 } {178 84}
-test winbutton-1.6 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.6 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
     eval destroy [winfo children .]
     label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0
     pack .l1
     update
     list [winfo reqwidth .l1] [winfo reqheight .l1]
 } {222 52}
-test winbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
     eval destroy [winfo children .]
     label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
     button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
@@ -129,7 +125,7 @@ test winbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable} {
 	    [winfo reqwidth .b3] [winfo reqheight .b3] \
 	    [winfo reqwidth .b4] [winfo reqheight .b4]
 } {74 24 67 97 174 46 64 28}
-test winbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
     eval destroy [winfo children .]
     label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
 	-highlightthickness 4
@@ -145,10 +141,26 @@ test winbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable} {
 	    [winfo reqwidth .b3] [winfo reqheight .b3] \
 	    [winfo reqwidth .b4] [winfo reqheight .b4]
 } {66 32 65 31 69 31 71 29}
-test winbutton-1.9 {TkpComputeButtonGeometry procedure} {
+test winbutton-1.9 {TkpComputeButtonGeometry procedure} {pcOnly} {
     eval destroy [winfo children .]
     button .b2 -bitmap question -default normal
     list [winfo reqwidth .b2] [winfo reqheight .b2]
 } {24 34}
 
+# cleanup
 eval destroy [winfo children .]
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/winClipboard.test b/tests/winClipboard.test
index 6727a27..446dbd1 100644
--- a/tests/winClipboard.test
+++ b/tests/winClipboard.test
@@ -7,41 +7,52 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winClipboard.test,v 1.3 1998/11/03 02:06:44 stanton Exp $
-
-if {$tcl_platform(platform)!="windows"} {
-    return
-}
+# RCS: @(#) $Id: winClipboard.test,v 1.4 1999/04/16 01:51:43 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 # Note that these tests may fail if another application is grabbing the
 # clipboard (e.g. an X server)
 
-test winClipboard-1.1 {TkSelGetSelection} {
+test winClipboard-1.1 {TkSelGetSelection} {pcOnly} {
     clipboard clear
     catch {selection get -selection CLIPBOARD} msg
     set msg
 } {CLIPBOARD selection doesn't exist or form "STRING" not defined}
-test winClipboard-1.2 {TkSelGetSelection} {
+test winClipboard-1.2 {TkSelGetSelection} {pcOnly} {
     clipboard clear
     clipboard append {}
     list [selection get -selection CLIPBOARD] [testclipboard]
 } {{} {}}
-test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {
+test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} {
     clipboard clear
     clipboard append abcd
     list [selection get -selection CLIPBOARD] [testclipboard]
 } {abcd abcd}
-test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {
+test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} {
     clipboard clear
     clipboard append "line 1\nline 2"
     list [selection get -selection CLIPBOARD] [testclipboard]
 } [list "line 1\nline 2" "line 1\r\nline 2"]
 
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/winDialog.test b/tests/winDialog.test
new file mode 100644
index 0000000..64ed21b
--- /dev/null
+++ b/tests/winDialog.test
@@ -0,0 +1,335 @@
+# This file is a Tcl script to test the Windows specific behavior of
+# the common dialog boxes.  It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: winDialog.test,v 1.2 1999/04/16 01:51:43 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info command testwinevent] == ""} {
+    puts "skipping: tests require the testwinevent command"
+    ::tcltest::cleanupTests
+    return
+}
+
+testwinevent debug 1
+
+eval destroy [winfo children .] 
+wm geometry . {}
+raise .
+
+proc start {arg} {
+    set ::tk_dialog 0
+
+    after 1 "$arg"
+}
+
+proc then {cmd} {
+    set ::command $cmd
+    set ::dialogresult {}
+
+    afterbody
+    vwait ::dialogresult
+    return $::dialogresult
+}
+
+proc afterbody {} {
+    if {$::tk_dialog == 0} {
+	after 100 {afterbody}
+	return
+    }
+    uplevel #0 {set dialogresult [eval $command]}
+}    
+
+proc Click {button} {
+    testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b
+    testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b
+}	    
+
+proc GetText {button} {
+    return [testwinevent $::tk_dialog $button WM_GETTEXT]
+}
+
+proc SetText {button text} {
+    return [testwinevent $::tk_dialog $button WM_SETTEXT $text]
+}
+
+test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} {
+} {}
+
+test winDialog-2.1 {ColorDlgHookProc} {nt} {
+} {}
+
+test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} {
+    start {tk_getOpenFile}
+    then {
+	set x [GetText 2]
+	Click 2
+    }
+    set x	
+} {Cancel}
+
+test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} {
+    start {tk_getSaveFile}
+    then {
+	set x [GetText 2]
+	Click 2
+    }
+    set x	
+} {Cancel}
+
+test winDialog-5.1 {GetFileName: no arguments} {nt} {
+    start {tk_getOpenFile -title Open}
+    then {
+	Click cancel
+    }
+} {0}
+test winDialog-5.2 {GetFileName: one argument} {nt} {
+    list [catch {tk_getOpenFile -foo} msg] $msg
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+test winDialog-5.4 {GetFileName: many arguments} {nt} {
+    start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
+    then {
+	Click cancel
+    }
+} {0}
+test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} {
+    list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} {
+    start {tk_getOpenFile -title bar}
+    then {
+	Click cancel
+    }
+} {0}
+test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} {
+    list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg
+} {1 {value for "-title" missing}}
+test winDialog-5.8 {GetFileName: extension begins with .} {nt} {
+#    if (string[0] == '.') {
+#	string++;
+#    }
+
+    start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
+    then {
+	SetText 0x480 bar
+	Click 1
+    }
+    set x
+} [file join [pwd] bar.foo]
+test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} {
+    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
+    then {
+	SetText 0x480 bar
+	Click 1
+    }
+    set x
+} [file join [pwd] bar.foo]
+test winDialog-5.10 {GetFileName: file types} {nt} {
+#	    case FILE_TYPES: 
+
+    start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
+    then {
+	set x [GetText 0x470]
+	Click cancel
+    }
+    set x
+} {foo files (*.foo)}
+test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} {
+#		if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) 
+
+    list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg
+} {1 {bad Macintosh file type "FOO"}}
+test winDialog-5.12 {GetFileName: initial directory} {nt} {
+#	    case FILE_INITDIR: 
+
+    start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
+    then {
+	Click 1
+    }
+    set x
+} {C:/12x 455}
+test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \
+	{nt} {
+#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
+    
+    list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+test winDialog-5.14 {GetFileName: initial file} {nt} {
+#	    case FILE_INITFILE: 
+
+    start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
+    then {
+	Click 1
+    }
+    set x
+} [file join [pwd] "12x 456"]
+test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
+#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
+    list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+append a $a
+append a $a
+append a $a
+append a $a
+test winDialog-5.16 {GetFileName: initial file: long name} {knownBug nt} {
+    start {set x [tk_getSaveFile -initialfile $a -title Long]}
+    then {
+	Click 1
+    }
+    set x
+} [string range [file join [pwd] $a] 0 257]
+test winDialog-5.17 {GetFileName: parent} {nt} {
+#	    case FILE_PARENT: 
+
+    toplevel .t
+    set x 0
+    start {tk_getOpenFile -parent .t -title Parent; set x 1}
+    then {
+	destroy .t
+    }
+    set x
+} {1}
+test winDialog-5.18 {GetFileName: title} {nt} {
+#	    case FILE_TITLE: 
+    
+    start {tk_getOpenFile -title Narf}
+    then {
+	Click 2
+    }
+} {0}
+test winDialog-5.19 {GetFileName: no filter specified} {nt} {
+#    if (ofn.lpstrFilter == NULL) 
+
+    start {tk_getOpenFile -title Filter} 
+    then {
+	set x [GetText 0x470]
+	Click 2
+    }
+    set x
+} {All Files (*.*)}
+test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} {
+#    if (Tk_WindowId(parent) == None) 
+
+    toplevel .t
+    start {tk_getOpenFile -parent .t -title Open}
+    then {
+	destroy .t
+    }
+} {}
+test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} {
+    toplevel .t
+    update
+    start {tk_getOpenFile -parent .t -title Open}
+    then {
+	destroy .t
+    }
+} {}
+test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} {
+#	    winCode = GetOpenFileName(&ofn);
+    
+    start {tk_getOpenFile -title Open}
+    then {
+	set x [GetText 1]
+	Click 2
+    }
+    set x
+} {&Open}
+test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} {
+#	    winCode = GetSaveFileName(&ofn);
+
+    start {tk_getSaveFile -title Save}
+    then {
+	set x [GetText 1]
+	Click 2
+    }
+    set x
+} {&Save}
+test winDialog-5.22 {GetFileName: convert \ to /} {nt} {
+    start {set x [tk_getSaveFile -title Back]}
+    then {
+	SetText 0x480 "c:\\12x 457"
+	Click 1
+    }
+    set x
+} {c:/12x 457}
+
+test winDialog-8.1 {OFNHookProc} {nt} {
+} {}
+
+test winDialog-6.1 {MakeFilter} {nt} {
+} {}
+
+test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} {
+    start {tk_chooseDirectory}
+    then {
+	Click cancel
+    }
+} {0}
+test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} {
+    list [catch {tk_chooseDirectory -foo} msg] $msg
+} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
+test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} {
+    start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test}
+    then {
+	Click cancel
+    }
+} {0}
+test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} \
+	{nt} {
+    list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg
+} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
+test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} \
+	{nt} {
+    start {tk_chooseDirectory -title bar}
+    then {
+	Click cancel
+    }
+} {0}
+test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} \
+	{nt} {
+    list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg
+} {1 {value for "-title" missing}}
+test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} {
+#	    case DIR_INITIAL: 
+
+    start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
+    then {
+	Click 1
+    }
+    string tolower [set x]
+} {c:/}
+test winDialog-5.13 \
+	{Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} \
+	{nt} {
+#		if (Tcl_TranslateFileName(interp, string, 
+#			&utfDirString) == NULL) 
+    
+    list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+
+test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {}
+
+testwinevent debug 0
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/winFont.test b/tests/winFont.test
index a02b461..2c2798e 100644
--- a/tests/winFont.test
+++ b/tests/winFont.test
@@ -7,18 +7,13 @@
 # but there are no results that can be checked.  
 #
 # Copyright (c) 1996-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winFont.test,v 1.3 1998/09/14 18:23:53 stanton Exp $
-
-if {$tcl_platform(platform)!="windows"} {
-    return
-}
+# RCS: @(#) $Id: winFont.test,v 1.4 1999/04/16 01:51:43 stanton Exp $
 
-if {[string compare test [info procs test]] != 0} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 catch {destroy .b}
@@ -45,10 +40,10 @@ proc getsize {} {
     return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
 }
 
-test winfont-1.1 {TkpGetNativeFont procedure: not native} {
+test winfont-1.1 {TkpGetNativeFont procedure: not native} {pcOnly} {
     list [catch {font measure {} xyz} msg] $msg
 } {1 {font "" doesn't exist}}
-test winfont-1.2 {TkpGetNativeFont procedure: native} {
+test winfont-1.2 {TkpGetNativeFont procedure: native} {pcOnly} {
     font measure ansifixed 0
     font measure ansi 0
     font measure device 0
@@ -58,98 +53,99 @@ test winfont-1.2 {TkpGetNativeFont procedure: native} {
     set x {}
 } {}
 
-test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {
+test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} {
     expr [font actual {-size -10} -size]>0
 } {1}
-test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {
+test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} {
     expr [font actual {-family Arial} -size]>0
 } {1}
-test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {
+test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {pcOnly} {
     font actual {-weight normal} -weight
 } {normal}
-test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {
+test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {pcOnly} {
     font actual {-weight bold} -weight
 } {bold}
-test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {
+test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {pcOnly} {
     catch {expr {[font actual {-size 10} -size]}}
 } 0
-test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {
+test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {pcOnly} {
     font actual {-family Arial} -family
 } {Arial}
-test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {
+test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {pcOnly} {
     set x {}
     lappend x [font actual {-family "Times"} -family]
     lappend x [font actual {-family "New York"} -family]
     lappend x [font actual {-family "Times New Roman"} -family]
 } {{Times New Roman} {Times New Roman} {Times New Roman}}
-test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {
+test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {pcOnly} {
     set x {}
     lappend x [font actual {-family "Courier"} -family]
     lappend x [font actual {-family "Monaco"} -family]
     lappend x [font actual {-family "Courier New"} -family]
 } {{Courier New} {Courier New} {Courier New}}
-test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
+test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {pcOnly} {
     set x {}
     lappend x [font actual {-family "Helvetica"} -family]
     lappend x [font actual {-family "Geneva"} -family]
     lappend x [font actual {-family "Arial"} -family]
 } {Arial Arial Arial}
-test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {
+test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {pcOnly} {
     # No way to get it to fail! Any font name is acceptable.
 } {}
 
-test winfont-3.1 {TkpDeleteFont procedure} {
+test winfont-3.1 {TkpDeleteFont procedure} {pcOnly} {
     font actual {-family xyz}
     set x {}
 } {}
 
-test winfont-4.1 {TkpGetFontFamilies procedure} {
+test winfont-4.1 {TkpGetFontFamilies procedure} {pcOnly} {
     font families
     set x {}
 } {}
 
-test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
+test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {pcOnly} {
     .b.l config -wrap 0 -text "000000"
     getsize
 } "[expr $ax*6] $ay"
-test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
+test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {pcOnly} {
     .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
     getsize
 } "[expr $ax*256] $ay"
-test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
+test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {pcOnly} {
     .b.l config -wrap [expr $ax*10] -text "00000000"
     getsize
 } "[expr $ax*8] $ay"
-test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
+test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {pcOnly} {
     .b.l config -wrap [expr $ax*6] -text "00000000"
     getsize
 } "[expr $ax*6] [expr $ay*2]"
-test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {
+test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {pcOnly} {
     .b.c dchars $t 0 end
     .b.c insert $t 0 "0000"
     .b.c index $t @[expr int($cx*2.5)],1
 } {2}
-test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} { 
+test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} {pcOnly} { 
     .b.l config -text "000000" -wrap 1
     getsize
 } "$ax [expr $ay*6]"
-test winfont-5.7 {Tk_MeasureChars procedure: whole words} {
+test winfont-5.7 {Tk_MeasureChars procedure: whole words} {pcOnly} {
     .b.l config -wrap [expr $ax*8] -text "000000 0000"
     getsize
 } "[expr $ax*6] [expr $ay*2]"
-test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {
+test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {pcOnly} {
     .b.l config -wrap [expr $ax*12] -text "000000    0000000"
     getsize
 } "[expr $ax*7] [expr $ay*2]"
-test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {
+test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {pcOnly} {
     .b.l config -wrap [expr $ax*12] -text "000  00   00000"
     getsize
 } "[expr $ax*7] [expr $ay*2]"
-test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
+test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {pcOnly} {
     .b.l config -wrap [expr $ax*12] -text "0000000000000000"
     getsize
 } "[expr $ax*12] [expr $ay*2]"
-test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} {
+test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} \
+	{pcOnly nonPortable} {
     set font [.b.l cget -font]
     .b.l config -font {{MS Sans Serif} 8} -text "W"
     set width [winfo reqwidth .b.l]
@@ -158,12 +154,12 @@ test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} {
     .b.l config -font $font
     expr $x < ($width*10)
 } 1
-test winfont-6.1 {Tk_DrawChars procedure: loop test} {
+test winfont-6.1 {Tk_DrawChars procedure: loop test} {pcOnly} {
     .b.l config -text "a"
     update
 } {}
 
-test winfont-7.1 {AllocFont procedure: use old font} {
+test winfont-7.1 {AllocFont procedure: use old font} {pcOnly} {
     font create xyz
     catch {destroy .c}
     button .c -font xyz
@@ -172,14 +168,29 @@ test winfont-7.1 {AllocFont procedure: use old font} {
     destroy .c
     font delete xyz
 } {}
-test winfont-7.2 {AllocFont procedure: extract info from logfont} {
+test winfont-7.2 {AllocFont procedure: extract info from logfont} {pcOnly} {
     font actual {arial 10 bold italic underline overstrike}
 } {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
-test winfont-7.3 {AllocFont procedure: extract info from textmetric} {
+test winfont-7.3 {AllocFont procedure: extract info from textmetric} {pcOnly} {
     font metric {arial 10 bold italic underline overstrike} -fixed
 } {0}
-test winfont-7.4 {AllocFont procedure: extract info from textmetric} {
+test winfont-7.4 {AllocFont procedure: extract info from textmetric} {pcOnly} {
     font metric systemfixed -fixed
 } {1}
 
+# cleanup
 destroy .b
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/winMenu.test b/tests/winMenu.test
index 96fdd21..576646f 100644
--- a/tests/winMenu.test
+++ b/tests/winMenu.test
@@ -4,37 +4,23 @@
 # system.
 #
 # Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winMenu.test,v 1.2 1998/09/14 18:23:53 stanton Exp $
-
-if {$tcl_platform(platform) != "windows"} {
-    return
-}
+# RCS: @(#) $Id: winMenu.test,v 1.3 1999/04/16 01:51:43 stanton Exp $
 
-if {![info exists INTERACTIVE]} {
-    puts " Some tests were skipped because they could not be performed"
-    puts " automatically on this platform. If you wish to execute them"
-    puts " interactively, set the TCL variable INTERACTIVE and re-run"
-    puts " the test."
-    set testConfig(menuInteractive) 0
-} else {
-    set testConfig(menuInteractive) 1
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 if {[lsearch [image types] test] < 0} {
     puts "This application hasn't been compiled with the \"test\" image"
     puts "type, so I can't run this test.  Are you sure you're using"
     puts "tktest instead of wish?"
+    ::tcltest::cleanupTests
     return
 }
 
-if {[info procs test] != "test"} {
-    source defs
-}
-
 proc deleteWindows {} {
     foreach i [winfo children .] {
     	catch [destroy $i]
@@ -45,23 +31,23 @@ deleteWindows
 wm geometry . {}
 raise .
 
-test winMenu-1.1 {GetNewID} {
+test winMenu-1.1 {GetNewID} {pcOnly} {
     catch {destroy .m1}
     list [catch {menu .m1} msg] $msg [destroy .m1]
 } {0 .m1 {}}
 # Basically impossible to test menu IDs wrapping.
 
-test winMenu-2.1 {FreeID} {
+test winMenu-2.1 {FreeID} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {destroy .m1} msg] $msg
 } {0 {}}
 
-test winMenu-3.1 {TkpNewMenu} {
+test winMenu-3.1 {TkpNewMenu} {pcOnly} {
     catch {destroy .m1}
     list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2
 } {0 .m1 0 {}}
-test winMenu-3.2 {TkpNewMenu} {
+test winMenu-3.2 {TkpNewMenu} {pcOnly} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
@@ -69,12 +55,12 @@ test winMenu-3.2 {TkpNewMenu} {
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
 } {0 {} {} 0 {}}
 
-test winMenu-4.1 {TkpDestroyMenu} {
+test winMenu-4.1 {TkpDestroyMenu} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {destroy .m1} msg] $msg
 } {0 {}}
-test winMenu-4.2 {TkpDestroyMenu - help menu} {
+test winMenu-4.2 {TkpDestroyMenu - help menu} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -menu .m1.system
@@ -82,7 +68,7 @@ test winMenu-4.2 {TkpDestroyMenu - help menu} {
     list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
 
-test winMenu-5.1 {TkpDestroyMenuEntry} {
+test winMenu-5.1 {TkpDestroyMenuEntry} {pcOnly} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
@@ -91,89 +77,89 @@ test winMenu-5.1 {TkpDestroyMenuEntry} {
     list [catch {.m1 delete 1} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test winMenu-6.1 {GetEntryText} {
+test winMenu-6.1 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     list [catch {menu .m1} msg] $msg [destroy .m1]
 } {0 .m1 {}}
-test winMenu-6.2 {GetEntryText} {
+test winMenu-6.2 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     catch {image delete image1}
     menu .m1
     image create test image1
     list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1]
 } {0 {} {} {}}
-test winMenu-6.3 {GetEntryText} {
+test winMenu-6.3 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.4 {GetEntryText} {
+test winMenu-6.4 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.5 {GetEntryText} {
+test winMenu-6.5 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.6 {GetEntryText} {
+test winMenu-6.6 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "This string has one & in it"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.7 {GetEntryText} {
+test winMenu-6.7 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "The & should be underlined." -underline 4} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.8 {GetEntryText} {
+test winMenu-6.8 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "The * should be underlined." -underline 4} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.9 {GetEntryText} {
+test winMenu-6.9 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "foo" -accel "bar"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.10 {GetEntryText} {
+test winMenu-6.10 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "This string has one & in it" -accel "bar"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.11 {GetEntryText} {
+test winMenu-6.11 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.12 {GetEntryText} {
+test winMenu-6.12 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "bar"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.13 {GetEntryText} {
+test winMenu-6.13 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "foo" -accel "&bar"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.14 {GetEntryText} {
+test winMenu-6.14 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "This string has one & in it" -accel "&bar"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.15 {GetEntryText} {
+test winMenu-6.15 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "The & should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-6.16 {GetEntryText} {
+test winMenu-6.16 {GetEntryText} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command -label "The * should be underlined." -underline 4 -accel "&bar"} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {
+test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -menu .m1.system
@@ -183,7 +169,7 @@ test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {
     .m1.system add command -label bar
     list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {
+test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label Hello
@@ -191,77 +177,77 @@ test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {
     .m1 add command -label foo
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.3 {ReconfigureWindowsMenu - zero items} {
+test winMenu-7.3 {ReconfigureWindowsMenu - zero items} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label Hello
     .m1 delete Hello
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.4 {ReconfigureWindowsMenu - one item} {
+test winMenu-7.4 {ReconfigureWindowsMenu - one item} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label Hello
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.5 {ReconfigureWindowsMenu - two items} {
+test winMenu-7.5 {ReconfigureWindowsMenu - two items} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label One
     .m1 add command -label Two
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.6 {ReconfigureWindowsMenu - separator item} {
+test winMenu-7.6 {ReconfigureWindowsMenu - separator item} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add separator
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} {
+test winMenu-7.7 {ReconfigureWindowsMenu - non-text item} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label Hello
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} {
+test winMenu-7.8 {ReconfigureWindowsMenu - disabled item} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label Hello -state disabled
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} {
+test winMenu-7.9 {ReconfigureWindowsMenu - non-selected checkbutton} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add checkbutton -label Hello
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} {
+test winMenu-7.10 {ReconfigureWindowsMenu - non-selected radiobutton} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add radiobutton -label Hello
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} {
+test winMenu-7.11 {ReconfigureWindowsMenu - selected checkbutton} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add checkbutton -label Hello
     .m1 invoke Hello
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} {
+test winMenu-7.12 {ReconfigureWindowsMenu - selected radiobutton} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add radiobutton -label Hello
     .m1 invoke Hello
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} {
+test winMenu-7.13 {ReconfigureWindowsMenu - cascade missing} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add cascade -label Hello
     list [catch {update idletasks} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {
+test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {pcOnly} {
     catch {destroy .m1}
     catch {destroy .m2}
     menu .m1 -tearoff 0
@@ -269,7 +255,7 @@ test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {
     .m1 add cascade -menu .m2 -label Hello
     list [catch {update idletasks} msg] $msg [destroy .m1] [destroy .m2]
 } {0 {} {} {}}
-test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {
+test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add cascade -menu .m1.file
@@ -277,7 +263,7 @@ test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {
     . configure -menu .m1
     list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {
+test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add cascade -menu .m1.system
@@ -287,7 +273,7 @@ test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {
     .m1.system add command -label Hello
     list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {
+test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add cascade -menu .m1.system
@@ -295,7 +281,7 @@ test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {
     . configure -menu .m1
     list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {
+test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add cascade -menu .m1.system
@@ -305,7 +291,7 @@ test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {
     . configure -menu .m1
     list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
-test winMenu-7.19 {ReconfigureWindowsMenu - column break} {
+test winMenu-7.19 {ReconfigureWindowsMenu - column break} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label one
@@ -314,23 +300,23 @@ test winMenu-7.19 {ReconfigureWindowsMenu - column break} {
 } {0 {} {}}
 
 #Don't know how to generate nested post menus
-test winMenu-8.1 {TkpPostMenu} {
+test winMenu-8.1 {TkpPostMenu} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -postcommand "blork"
     list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
 } {1 {invalid command name "blork"} {}}
-test winMenu-8.2 {TkpPostMenu} {
+test winMenu-8.2 {TkpPostMenu} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -postcommand "destroy .m1"
     list [.m1 post 40 40] [winfo exists .m1]
 } {{} 0}
-test winMenu-8.3 {TkpPostMenu - popup menu} {menuInteractive} {
+test winMenu-8.3 {TkpPostMenu - popup menu} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "winMenu-8.3: Hit ESCAPE."
     list [.m1 post 40 40] [destroy .m1]
 } {{} {}}
-test winMenu-8.4 {TkpPostMenu - menu button} {menuInteractive} {
+test winMenu-8.4 {TkpPostMenu - menu button} {pcOnly userInteraction} {
     catch {destroy .mb}
     menubutton .mb -text test -menu .mb.menu
     menu .mb.menu
@@ -338,7 +324,7 @@ test winMenu-8.4 {TkpPostMenu - menu button} {menuInteractive} {
     pack .mb
     list [tkMbPost .mb] [destroy .m1]
 } {{} {}}
-test winMenu-8.5 {TkpPostMenu - update not pending} {menuInteractive} {
+test winMenu-8.5 {TkpPostMenu - update not pending} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "winMenu-8.5 - Hit ESCAPE."
@@ -346,13 +332,13 @@ test winMenu-8.5 {TkpPostMenu - update not pending} {menuInteractive} {
     list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test winMenu-9.1 {TkpMenuNewEntry} {
+test winMenu-9.1 {TkpMenuNewEntry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [catch {.m1 add command} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test winMenu-10.1 {TkwinMenuProc} {menuInteractive} {
+test winMenu-10.1 {TkwinMenuProc} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "winMenu-10.1: Hit ESCAPE."
@@ -360,46 +346,63 @@ test winMenu-10.1 {TkwinMenuProc} {menuInteractive} {
 } {{} {}}
 
 # Can't generate a WM_INITMENU without a Tk menu yet.
-test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {menuInteractive} {
+test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {pcOnly userInteraction} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1 -postcommand "set foo test"
     .m1 add command -label "winMenu-11.1: Hit ESCAPE."
     list [.m1 post 40 40] [set foo] [unset foo] [destroy .m1]
 } {test test {} {}}
-test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {menuInteractive} {
+test winMenu-11.2 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} {
     catch {destroy .m1}
     catch {unset foo}
     menu .m1
     .m1 add checkbutton -variable foo -label "winMenu-11.2: Please select this menu item."
     list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1]
 } {{} {} 1 {} {}}
+test winMenu-11.3 {TkWinHandleMenuEvent - WM_COMMAND} {pcOnly userInteraction} {
+    catch {destroy .m1}
+    catch {unset foo}
+    proc bgerror {args} {
+	global foo errorInfo
+	set foo [list $args $errorInfo]
+    }
+    menu .m1
+    .m1 add command -command {error 1} -label "winMenu-11.2: Please select this menu item."
+    list [.m1 post 40 40] [update] [set foo] [unset foo] [destroy .m1]
+} {{} {} {1 {1
+    while executing
+"error 1"
+    (menu invoke)}} {} {}}
+
 # Can't test WM_MENUCHAR
-test winMenu-11.3 {TkWinHandleMenuEvent - WM_MEASUREITEM} {menuInteractive} {
+test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "winMenu-11.3: Hit ESCAPE."
     list [.m1 post 40 40] [destroy .m1]
 } {{} {}}
-test winMenu-11.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {menuInteractive} {
+test winMenu-11.5 {TkWinHandleMenuEvent - WM_MEASUREITEM} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label "winMenu-11.4: Hit ESCAPE" -hidemargin 1
     list [.m1 post 40 40] [destroy .m1]
 } {{} {}}
-test winMenu-11.5 {TkWinHandleMenuEvent - WM_DRAWITEM} {menuInteractive} {
+test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "winMenu-11.5: Hit ESCAPE."
     list [.m1 post 40 40] [destroy .m1]
 } {{} {}}
-test winMenu-11.6 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} {menuInteractive} {
+test winMenu-11.7 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} \
+	{pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "winMenu-11.6: Hit ESCAPE." -state disabled
     list [.m1 post 40 40] [destroy .m1]
 } {{} {}}
-test winMenu-11.7 {TkWinHandleMenuEvent - WM_INITMENU - not pending} {menuInteractive} {
+test winMenu-11.8 {TkWinHandleMenuEvent - WM_INITMENU - not pending} \
+	{pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label "winMenu-11.7: Hit ESCAPE"
@@ -407,14 +410,14 @@ test winMenu-11.7 {TkWinHandleMenuEvent - WM_INITMENU - not pending} {menuIntera
     list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test winMenu-12.1 {TkpSetWindowMenuBar} {
+test winMenu-12.1 {TkpSetWindowMenuBar} {pcOnly} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
     .m1 add command -label foo
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
 } {0 {} {} 0 {}}
-test winMenu-12.2 {TkpSetWindowMenuBar} {
+test winMenu-12.2 {TkpSetWindowMenuBar} {pcOnly} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1
@@ -422,7 +425,7 @@ test winMenu-12.2 {TkpSetWindowMenuBar} {
     . configure -menu .m1
     list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2
 } {0 {} 0 {}}
-test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {
+test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {pcOnly} {
     catch {destroy .m1}
     . configure -menu ""
     menu .m1 -tearoff 0
@@ -431,48 +434,48 @@ test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {
     list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
 } {0 {} {} {}}
 
-test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {} {}
+test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest pcOnly} {} {}
 
-test winMenu-14.1 {GetMenuIndicatorGeometry} {
+test winMenu-14.1 {GetMenuIndicatorGeometry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo
     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 } {0 {}}
-test winMenu-14.2 {GetMenuIndicatorGeometry} {
+test winMenu-14.2 {GetMenuIndicatorGeometry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo -hidemargin 1
     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 } {0 {}}
 
-test winMenu-15.1 {GetMenuAccelGeometry} {
+test winMenu-15.1 {GetMenuAccelGeometry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -label foo -accel Ctrl+U
     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 } {0 {}}
-test winMenu-15.2 {GetMenuAccelGeometry} {
+test winMenu-15.2 {GetMenuAccelGeometry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 } {0 {}}
-test winMenu-15.3 {GetMenuAccelGeometry} {
+test winMenu-15.3 {GetMenuAccelGeometry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo -accel "Ctrl+U"
     list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
 } {0 {}}
 
-test winMenu-16.1 {GetTearoffEntryGeometry} {menuInteractive} {
+test winMenu-16.1 {GetTearoffEntryGeometry} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "winMenu-19.1: Hit ESCAPE."
     list [.m1 post 40 40] [destroy .m1]
 } {{} {}}
 
-test winMenu-17.1 {GetMenuSeparatorGeometry} {
+test winMenu-17.1 {GetMenuSeparatorGeometry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add separator
@@ -481,7 +484,7 @@ test winMenu-17.1 {GetMenuSeparatorGeometry} {
 
 # Currently, the only callers to DrawWindowsSystemBitmap want things
 # centered vertically, and either centered or right aligned horizontally.
-test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {
+test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo
@@ -489,7 +492,7 @@ test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {
+test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -label foo
@@ -497,21 +500,22 @@ test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {
     list [update] [destroy .m1]
 } {{} {}}
 
-test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} {
+test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {
+test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {
+test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo
@@ -519,7 +523,7 @@ test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {
+test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add radiobutton -label foo
@@ -527,7 +531,7 @@ test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {
+test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo
@@ -536,7 +540,7 @@ test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {
+test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo -indicatoron 0
@@ -545,42 +549,44 @@ test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {
     list [update] [destroy .m1]
 } {{} {}}
 
-test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {
+test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -disabledforeground red
     .m1 add command -label foo -accel "Ctrl+U" -state disabled
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {
+test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo -accel "Ctrl+U"
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} {
+test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1 -disabledforeground ""
     .m1 add command -label foo -accel "Ctrl+U" -state disabled
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {
+test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -label foo
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} {menuInteractive} {
+test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} \
+	{pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -label "winMenu-23.5: Hit ESCAPE."
     list [.m1 post 40 40] [destroy .m1]
 } {{} {}}
 
-test winMenu-21.1 {DrawMenuSeparator} {
+test winMenu-21.1 {DrawMenuSeparator} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add separator
@@ -588,7 +594,7 @@ test winMenu-21.1 {DrawMenuSeparator} {
     list [update] [destroy .m1]
 } {{} {}}
 
-test winMenu-22.1 {DrawMenuUnderline} {
+test winMenu-22.1 {DrawMenuUnderline} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo -underline 0
@@ -596,24 +602,26 @@ test winMenu-22.1 {DrawMenuUnderline} {
     list [update] [destroy .m1]
 } {{} {}}   
 
-test winMenu-23.1 {Don't know how to test MenuKeyBindProc} {} {}
-test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} {} {}
+test winMenu-23.1 {Don't know how to test MenuKeyBindProc} \
+	{pcOnly emptyTest} {} {}
+test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} \
+	{pcOnly emptyTest} {} {}
 
-test winMenu-25.1 {DrawMenuEntryLabel - normal} {
+test winMenu-25.1 {DrawMenuEntryLabel - normal} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {
+test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -disabledforeground red
     .m1 add command -label foo -state disabled
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {
+test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -disabledforeground ""
     .m1 add command -label foo -state disabled
@@ -621,27 +629,27 @@ test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {
     list [update] [destroy .m1]
 } {{} {}}
 
-test winMenu-26.1 {TkpComputeMenubarGeometry} {
+test winMenu-26.1 {TkpComputeMenubarGeometry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -label File
     list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
 } {{} {} {}}
 
-test winMenu-27.1 {DrawTearoffEntry} {menuInteractive} {
+test winMenu-27.1 {DrawTearoffEntry} {pcOnly userInteraction} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "winMenu-24.4: Hit ESCAPE."
     list [.m1 post 40 40] [destroy .m1]
 } {{} {}}
 
-test winMenu-28.1 {TkpConfigureMenuEntry - update pending} {
+test winMenu-28.1 {TkpConfigureMenuEntry - update pending} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label Hello
     list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
 } {0 {} {}}
-test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {
+test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label One
@@ -649,7 +657,8 @@ test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {
     list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
 } {0 {} {}}
 
-test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} {
+test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
@@ -657,7 +666,8 @@ test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} {
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} {
+test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo -activeforeground red
@@ -665,7 +675,7 @@ test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} {
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {
+test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     set tk_strictMotif 1
@@ -674,42 +684,44 @@ test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1] [set tk_strictMotif 0]
 } {{} {} 0}
-test winMenu-29.4 {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} {
+test winMenu-29.4 \
+	{TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1 -disabledforeground blue
     .m1 add command -label foo -state disabled -background red
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {
+test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -disabledforeground blue
     .m1 add command -label foo -state disabled
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {
+test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -disabledforeground ""
     .m1 add command -label foo -state disabled
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {
+test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo -foreground red
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {
+test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {
+test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo -selectcolor orange
@@ -717,7 +729,7 @@ test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {
+test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label foo
@@ -725,7 +737,7 @@ test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {
+test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo -activebackground green
@@ -733,7 +745,7 @@ test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.12 {TkpDrawMenuEntry - border} {
+test winMenu-29.12 {TkpDrawMenuEntry - border} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
@@ -741,7 +753,7 @@ test winMenu-29.12 {TkpDrawMenuEntry - border} {
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {
+test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {pcOnly} {
     catch {destroy .m1}
     set tk_strictMotif 1
     menu .m1
@@ -750,7 +762,7 @@ test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1] [set tk_strictMotif 0]
 } {{} {} 0}
-test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {
+test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo -activeforeground yellow
@@ -758,7 +770,7 @@ test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.15 {TkpDrawMenuEntry - active border} {
+test winMenu-29.15 {TkpDrawMenuEntry - active border} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
@@ -766,35 +778,35 @@ test winMenu-29.15 {TkpDrawMenuEntry - active border} {
     .m1 entryconfigure 1 -state active
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {
+test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo -font "Helvectica 72"
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.17 {TkpDrawMenuEntry - font} {
+test winMenu-29.17 {TkpDrawMenuEntry - font} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -font "Courier 72"
     .m1 add command -label foo
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.18 {TkpDrawMenuEntry - separator} {
+test winMenu-29.18 {TkpDrawMenuEntry - separator} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add separator
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.19 {TkpDrawMenuEntry - standard} {
+test winMenu-29.19 {TkpDrawMenuEntry - standard} {pcOnly} {
     catch {destroy .mb}
     menu .m1
     .m1 add command -label foo
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {
+test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add cascade -label File -menu .m1.file
@@ -804,7 +816,7 @@ test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.21 {TkpDrawMenuEntry - indicator} {
+test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label winMenu-31.20
@@ -812,7 +824,7 @@ test winMenu-29.21 {TkpDrawMenuEntry - indicator} {
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-29.22 {TkpDrawMenuEntry - indicator} {
+test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label winMenu-31.21 -hidemargin 1
@@ -821,7 +833,7 @@ test winMenu-29.22 {TkpDrawMenuEntry - indicator} {
     list [update] [destroy .m1]
 } {{} {}}
 
-test winMenu-30.1 {GetMenuLabelGeometry - image} {
+test winMenu-30.1 {GetMenuLabelGeometry - image} {pcOnly} {
     catch {destroy .m1}
     catch {image delete image1}
     menu .m1
@@ -829,33 +841,33 @@ test winMenu-30.1 {GetMenuLabelGeometry - image} {
     .m1 add command -image image1
     list [update idletasks] [destroy .m1] [image delete image1]
 } {{} {} {}}
-test winMenu-30.2 {GetMenuLabelGeometry - bitmap} {
+test winMenu-30.2 {GetMenuLabelGeometry - bitmap} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -bitmap questhead
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-30.3 {GetMenuLabelGeometry - no text} {
+test winMenu-30.3 {GetMenuLabelGeometry - no text} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-30.4 {GetMenuLabelGeometry - text} {
+test winMenu-30.4 {GetMenuLabelGeometry - text} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "This is a test."
     list [update idletasks] [destroy .m1]
 } {{} {}}
 
-test winMenu-31.1 {DrawMenuEntryBackground} {
+test winMenu-31.1 {DrawMenuEntryBackground} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
     set tearoff [tkTearOffMenu .m1 40 40]
     list [update] [destroy .m1]
 } {{} {}}
-test winMenu-31.2 {DrawMenuEntryBackground} {
+test winMenu-31.2 {DrawMenuEntryBackground} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label foo
@@ -864,25 +876,25 @@ test winMenu-31.2 {DrawMenuEntryBackground} {
     list [update] [destroy .m1]
 } {{} {}}
 
-test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} {
+test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} {
+test winMenu-32.2 {TkpComputeStandardMenuGeometry - one entry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "one"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} {
+test winMenu-32.3 {TkpComputeStandardMenuGeometry - more than one entry} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "one"
     .m1 add command -label "two"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} {
+test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add separator
@@ -897,60 +909,65 @@ test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
     catch {tkMbPost .mb}
     list [update] [destroy .mb]
 } {{} {}}
-test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} {
+test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} {
+test winMenu-32.7 {TkpComputeStandardMenuGeometry - different font for entry} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1 -font "Helvetica 12"
     .m1 add command -label "test" -font "Courier 12"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} {
+test winMenu-32.8 {TkpComputeStandardMenuGeometry - second entry larger} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test"
     .m1 add command -label "test test"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} {
+test winMenu-32.9 {TkpComputeStandardMenuGeometry - first entry larger} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test test"
     .m1 add command -label "test"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} {
+test winMenu-32.10 {TkpComputeStandardMenuGeometry - accelerator} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test" -accel "Ctrl+S"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} {
+test winMenu-32.11 {TkpComputeStandardMenuGeometry - second accel larger} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test" -accel "1"
     .m1 add command -label "test" -accel "1 1"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} {
+test winMenu-32.12 {TkpComputeStandardMenuGeometry - second accel smaller} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label "test" -accel "1 1"
     .m1 add command -label "test" -accel "1"
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {
+test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add checkbutton -label test
     .m1 invoke 1
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.14 {TkpComputeStandardMenuGeometry - second indicator less or equal } {
+test winMenu-32.14 \
+	{TkpComputeStandardMenuGeometry - second indicator less or equal} \
+	{pcOnly} {
     catch {destroy .m1}
     catch {image delete image1}
     image create test image1
@@ -961,7 +978,8 @@ test winMenu-32.14 {TkpComputeStandardMenuGeometry - second indicator less or eq
     .m1 invoke 2
     list [update idletasks] [destroy .m1] [image delete image1]
 } {{} {} {}}
-test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unixOnly} {
+test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \
+	{unixOnly} {
     catch {destroy .m1}
     catch {image delete image1}
     image create test image1
@@ -972,12 +990,14 @@ test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger } {
     .m1 invoke 2
     list [update idletasks] [destroy .m1] [image delete image1]
 } {{} {} {}}
-test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} {
+test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} {
+test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1
     .m1 add command -label one
@@ -985,7 +1005,8 @@ test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} {
     .m1 add command -label three -columnbreak 1
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} {
+test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \
+	{pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label one
@@ -993,7 +1014,7 @@ test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} {
     .m1 add command -label three
     list [update idletasks] [destroy .m1]
 } {{} {}}
-test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {
+test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {pcOnly} {
     catch {destroy .m1}
     menu .m1 -tearoff 0
     .m1 add command -label one
@@ -1005,14 +1026,14 @@ test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {
     list [update idletasks] [destroy .m1]    
 } {{} {}}
 
-test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} {
+test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} {pcOnly} {
     catch {destroy .t2}
     catch {destroy .m1}
     toplevel .t2 -menu .m1
     wm geometry .t2 +0+0
     list [update idletasks] [destroy .t2]
 } {{} {}}
-test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {
+test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {pcOnly} {
     catch {destroy .t2}
     catch {destroy .m1}
     menu .m1
@@ -1025,6 +1046,21 @@ test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {
     list [update idletasks] [destroy .m1] [destroy .t2]
 } {{} {} {}}
 
-test winMenu-34.1 {TkpMenuInit called at boot time} {} {}
+test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest pcOnly} {} {}
 
+# cleanup
 deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/winSend.test b/tests/winSend.test
new file mode 100644
index 0000000..34819b5
--- /dev/null
+++ b/tests/winSend.test
@@ -0,0 +1,428 @@
+# This file is a Tcl script to test out the "send" command and the
+# other procedures in the file tkSend.c.  It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: winSend.test,v 1.2 1999/04/16 01:51:44 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {$tcl_platform(platform) != "windows"} {
+    puts "skipping: Windows only tests..."
+    ::tcltest::cleanupTests
+    return
+}
+
+if {[info commands send] != "send"} {
+    puts "skipping: Unimplemented send command"
+    ::tcltest::cleanupTests
+    return
+}
+
+foreach i [winfo children .] {
+    destroy $i
+}
+wm geometry . {}
+raise .
+
+set currentInterps [winfo interps]
+
+if {[catch {exec tktest &}] == 1} {
+    puts "Could not run winSend.test because another instance of tktest could not be loaded."
+    ::tcltest::cleanupTests
+    return;
+}
+
+# Compute a script that will load Tk into a child interpreter.
+
+foreach pkg [info loaded] {
+    if {[lindex $pkg 1] == "Tk"} {
+	set loadTk "load $pkg"
+	break
+    }
+}
+
+# Procedure to create a new application with a given name and class.
+
+proc newApp {name {safe {}}} {
+    global loadTk
+    if {[string compare $safe "-safe"] == 0} {
+	interp create -safe $name
+    } else {
+	interp create $name
+    }
+    $name eval [list set argv [list -name $name]]
+    catch {eval $loadTk $name}
+}
+
+# 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 we have found our interpreter we are going to send to. Make sure that
+# it works first.
+if {[catch {send $interp {console hide; update}}] == 1} {
+    puts "Could not send to child interpreter $interp"
+    ::tcltest::cleanupTests
+   return
+}
+
+# setting up dde server is done when the first interp is created and
+# cannot be tested very easily.
+test winSend-1.1 {Tk_SetAppName - changing name of interp} {
+    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} {
+    newApp testApp
+    newApp testApp2
+    list [testApp eval tk appname testApp3] [interp delete testApp] [interp delete testApp2]
+} {testApp3 {} {}}
+test winSend-1.3 {Tk_SetAppName - unique name - no conflicts} {
+    newApp testApp
+    list [testApp eval tk appname testApp] [interp delete testApp]
+} {testApp {}}
+test winSend-1.4 {Tk_SetAppName - unique name - one conflict} {
+    newApp testApp
+    newApp foobar
+    list [foobar eval tk appname testApp] [interp delete foobar] [interp delete testApp]
+} {{testApp #2} {} {}}
+test winSend-1.5 {Tk_SetAppName - unique name - one conflict} {
+    newApp testApp
+    newApp foobar
+    newApp blaz
+    foobar eval tk appname testApp
+    list [blaz eval tk appname testApp] [interp delete foobar] [interp delete testApp] [interp delete blaz]
+} {{testApp #3} {} {} {}}
+test winSend-1.6 {Tk_SetAppName - safe interps} {
+    newApp testApp -safe
+    list [catch {testApp eval send testApp {set foo a}} msg] $msg [interp delete testApp]
+} {1 {invalid command name "send"} {}}
+
+test winSend-2.1 {Tk_SendObjCmd - # of args} {
+    list [catch {send tktest} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} {
+    list [catch {send -bogus tktest} msg] $msg
+} {1 {bad option "-bogus": must be -async, -displayof, or --}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} {
+    list [catch {send -async bogus foo} msg] $msg
+} {1 {no registered server named "bogus"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} {
+    list [catch {send -displayof . bogus foo} msg] $msg
+} {1 {no registered server named "bogus"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} {
+    list [catch {send -- -bogus foo} msg] $msg
+} {1 {no registered server named "-bogus"}}
+test winSend-2.2 {Tk_SendObjCmd - sending to ourselves} {
+    list [send [tk appname] {set foo a}]
+} {a}
+test winSend-2.3 {Tk_SendObjCmd - sending to ourselves in a different interpreter} {
+    newApp testApp
+    list [catch {send testApp {set foo b}} msg] $msg [interp delete testApp]
+} {0 b {}}
+test winSend-2.4 {Tk_SendObjCmd - sending to ourselves in a different interp with errors} {
+    newApp testApp
+    list [catch {send testApp {expr 2 / 0}} msg] $msg $errorCode $errorInfo [interp delete testApp]
+} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n    while executing\n\"expr 2 / 0\"\n    invoked from within\n\"send testApp {expr 2 / 0}\"} {}"
+test winSend-2.5 {Tk_SendObjCmd - sending to another app async} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {send -async $interp {set foo a}} msg] $msg
+} {0 {}}
+test winSend-2.6 {Tk_SendObjCmd - sending to another app sync - no error} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {send $interp {set foo a}} msg] $msg
+} {0 a}
+test winSend-2.7 {Tk_SendObjCmd - sending to another app - error} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {send $interp {expr 2 / 0}} msg] $msg $errorCode $errorInfo
+} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n    while executing\n\"expr 2 / 0\"\n    invoked from within\n\"send \$interp {expr 2 / 0}\"}"
+
+test winSend-3.1 {TkGetInterpNames} {
+    set origLength [llength $currentInterps]
+    set newLength [llength [winfo interps]]
+    expr {($newLength - 2) == $origLength}
+} {1}
+
+test winSend-4.1 {DeleteProc - changing name of app} {
+    newApp a
+    list [a eval tk appname foo] [interp delete a]
+} {foo {}}
+test winSend-4.2 {DeleteProc - normal} {
+    newApp a
+    list [interp delete a]
+} {{}}
+
+test winSend-5.1 {ExecuteRemoteObject - no error} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [send $interp {send [tk appname] {expr 2 / 1}}]
+} {2}
+test winSend-5.2 {ExecuteRemoteObject - error} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {send $interp {send [tk appname] {expr 2 / 0}}} msg] $msg
+} {1 {divide by zero}}
+
+test winSend-6.1 {SendDDEServer - XTYP_CONNECT} {
+    set foo "Hello, World"
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    set command "dde request Tk [tk appname] foo"
+    list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.2 {SendDDEServer - XTYP_CONNECT_CONFIRM} {
+    set foo "Hello, World"
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    set command "dde request Tk [tk appname] foo"
+    list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.3 {SendDDEServer - XTYP_DISCONNECT} {
+    set foo "Hello, World"
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    set command "dde request Tk [tk appname] foo"
+    list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.4 {SendDDEServer - XTYP_REQUEST variable} {
+    set foo "Hello, World"
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    set command "dde request Tk [tk appname] foo"
+    list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.5 {SendDDEServer - XTYP_REQUEST array} {
+    catch {unset foo}
+    set foo(test) "Hello, World"
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    set command "dde request Tk [tk appname] foo(test)"
+    list [catch "send \{$interp\} \{$command\}" msg] $msg [catch {unset foo}]
+} {0 {Hello, World} 0}
+test winSend-6.6 {SendDDEServer - XTYP_REQUEST return results} {
+    set foo 3
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    set command "send [tk appname] {expr $foo + 1}"
+    list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 4}
+test winSend-6.7 {SendDDEServer - XTYP_EXECUTE} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    set command "send [tk appname] {expr 4 / 2}"
+    list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 2}
+test winSend-6.8 {SendDDEServer - XTYP_WILDCONNECT} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    set command "dde services Tk {}"
+    list [catch "send \{$interp\} \{$command\}"]
+} {0}
+
+test winSend-7.1 {DDEExitProc} {
+    newApp testApp
+    list [interp delete testApp]
+} {{}}
+
+test winSend-8.1 {SendDdeConnect} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [send $interp {set tk foo}]
+} {foo}
+
+test winSend-9.1 {SetDDEError} {
+    list [catch {dde execute Tk foo {set foo hello}} msg] $msg
+} {1 {dde command failed}}
+
+test winSend-10.1 {Tk_DDEObjCmd - wrong num args} {
+    list [catch {dde} msg] $msg
+} {1 {wrong # args: should be "dde ?-async? serviceName topicName value"}}
+test winSend-10.2 {Tk_DDEObjCmd - unknown subcommand} {
+    list [catch {dde foo} msg] $msg
+} {1 {bad command "foo": must be execute, request, or services}}
+test winSend-10.3 {Tk_DDEObjCmd - execute - wrong num args} {
+    list [catch {dde execute} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.4 {Tk_DDEObjCmd - execute - wrong num args} {
+    list [catch {dde execute 3 4 5 6 7} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.5 {Tk_DDEObjCmd - execute async - wrong num args} {
+    list [catch {dde execute -async} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.6 {Tk_DDEObjCmd - request - wrong num args} {
+    list [catch {dde request} msg] $msg
+} {1 {wrong # args: should be "dde request serviceName topicName value"}}
+test winSend-10.7 {Tk_DDEObjCmd - services wrong num args} {
+    list [catch {dde services} msg] $msg
+} {1 {wrong # args: should be "dde services serviceName topicName"}}
+test winSend-10.8 {Tk_DDEObjCmd - null service name} {
+    list [catch {dde services {} {tktest #2}}]
+} {0}
+test winSend-10.9 {Tk_DDEObjCmd - null topic name} {
+    list [catch {dde services {Tk} {}}]
+} {0}
+test winSend-10.10 {Tk_DDEObjCmd - execute - nothing to execute} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {dde execute Tk $interp {}} msg] $msg
+} {1 {cannot execute null data}}
+test winSend-10.11 {Tk_DDEObjCmd - execute - no such conversation} {
+    list [catch {dde execute Tk foo {set foo hello}} msg] $msg
+} {1 {dde command failed}}
+test winSend-10.12 {Tk_DDEObjCmd - execute - async} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {dde execute -async Tk $interp {set foo hello}} msg] $msg
+} {0 {}}
+test winSend-10.13 {Tk_DDEObjCmd - execute} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {dde execute Tk $interp {set foo goodbye}} msg] $msg
+} {0 {}}
+test winSend-10.14 {Tk_DDEObjCmd - request - nothing to request} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {dde request Tk $interp {}} msg] $msg
+} {1 {cannot request value of null data}}
+test winSend-10.15 {Tk_DDEObjCmd - request - invalid interp} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    list [catch {dde request Tk foo foo} msg] $msg
+} {1 {dde command failed}}
+test winSend-10.16 {Tk_DDEObjCmd - invalid variable} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    send $interp {unset foo}
+    list [catch {dde request Tk $interp foo} msg] $msg
+} {1 {remote server cannot handle this command}}
+test winSend-10.17 {Tk_DDEObjCmd - valid variable} {
+    set newInterps [winfo interps]
+    foreach interp $newInterps {
+	if {[lsearch $currentInterps $interp] < 0} {
+	    break
+	}
+    }
+    send $interp {set foo winSend-10.17}
+    list [catch {dde request Tk $interp foo} msg] $msg
+} {0 winSend-10.17}
+test winSend-10.18 {Tk_DDEObjCmd - services} {
+    set currentService [list Tk [tk appname]]
+    list [catch {dde services Tk {}} msg] [expr [lsearch $msg $currentService] >= 0]
+} {0 1}
+
+# Get rid of the other app and all of its interps
+
+set newInterps [winfo interps]
+while {[llength $newInterps] != [llength $currentInterps]} {
+    foreach interp $newInterps {
+	if {[lsearch -exact $currentInterps $interp] < 0} {
+	    catch {send $interp exit}
+	    set newInterps [winfo interps]
+	    break
+	}
+    }
+}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tests/winWm.test b/tests/winWm.test
index c48fc3b..e4275fe 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -6,18 +6,13 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1996 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winWm.test,v 1.2 1998/09/14 18:23:53 stanton Exp $
-
-if {$tcl_platform(platform) != "windows"} {
-    return
-}
+# RCS: @(#) $Id: winWm.test,v 1.3 1999/04/16 01:51:44 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -41,7 +36,7 @@ update
 set menuheight [expr $menuheight - [winfo y .t]]
 destroy .t
 
-test winWm-1.1 {TkWmMapWindow} {
+test winWm-1.1 {TkWmMapWindow} {pcOnly} {
     toplevel .t
     wm override .t 1
     wm geometry .t +0+0
@@ -50,7 +45,7 @@ test winWm-1.1 {TkWmMapWindow} {
     destroy .t
     set result
 } {0 0}
-test winWm-1.2 {TkWmMapWindow} {
+test winWm-1.2 {TkWmMapWindow} {pcOnly} {
     toplevel .t
     wm transient .t .
     update
@@ -62,7 +57,7 @@ test winWm-1.2 {TkWmMapWindow} {
     destroy .t
     set msg
 } {can't iconify ".t": it is a transient}
-test winWm-1.3 {TkWmMapWindow} {
+test winWm-1.3 {TkWmMapWindow} {pcOnly} {
     toplevel .t
     update
     toplevel .t2
@@ -71,7 +66,7 @@ test winWm-1.3 {TkWmMapWindow} {
     destroy .t .t2
     set result
 } 1
-test winWm-1.4 {TkWmMapWindow} {
+test winWm-1.4 {TkWmMapWindow} {pcOnly} {
     toplevel .t
     wm geometry .t +10+10
     update
@@ -82,7 +77,7 @@ test winWm-1.4 {TkWmMapWindow} {
     destroy .t .t2
     set result
 } {10 40}
-test winWm-1.5 {TkWmMapWindow} {
+test winWm-1.5 {TkWmMapWindow} {pcOnly} {
     toplevel .t
     wm iconify .t
     update
@@ -91,7 +86,7 @@ test winWm-1.5 {TkWmMapWindow} {
     set result
 } iconic
 
-test winWm-2.1 {TkpWmSetState} {
+test winWm-2.1 {TkpWmSetState} {pcOnly} {
     toplevel .t
     wm geometry .t 150x50+10+10
     update
@@ -105,7 +100,7 @@ test winWm-2.1 {TkpWmSetState} {
     destroy .t
     set result
 } {normal iconic normal}
-test winWm-2.2 {TkpWmSetState} {
+test winWm-2.2 {TkpWmSetState} {pcOnly} {
     toplevel .t
     wm geometry .t 150x50+10+10
     update
@@ -122,7 +117,7 @@ test winWm-2.2 {TkpWmSetState} {
     destroy .t
     set result
 } {normal withdrawn iconic normal}
-test winWm-2.3 {TkpWmSetState} {
+test winWm-2.3 {TkpWmSetState} {pcOnly} {
     set result {}
     toplevel .t
     wm geometry .t 150x50+10+10
@@ -142,7 +137,7 @@ test winWm-2.3 {TkpWmSetState} {
 } {{normal 150x50+10+10} {iconic 150x50+10+10} {iconic 150x50+10+10} {normal 200x50+10+10}}
 
 
-test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {
+test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} {
     toplevel .t
     wm geometry .t +0+0
     button .t.b
@@ -161,7 +156,7 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {
     set x
 } 1
 
-test winWm-4.1 {ConfigureTopLevel: menu resizing} {
+test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} {
     set result {}
     toplevel .t
     frame .t.f -width 150 -height 50 -bg red
@@ -178,7 +173,7 @@ test winWm-4.1 {ConfigureTopLevel: menu resizing} {
     set result
 } [expr $menuheight + 1]
 
-test winWm-5.1 {UpdateGeometryInfo: menu resizing} {
+test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} {
     set result {}
     toplevel .t
     frame .t.f -width 150 -height 50 -bg red
@@ -197,7 +192,7 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} {
     destroy .t
     set result
 } {50 50 50}
-test winWm-5.2 {UpdateGeometryInfo: menu resizing} {
+test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} {
     set result {}
     toplevel .t
     frame .t.f -width 150 -height 50 -bg red
@@ -217,3 +212,19 @@ test winWm-5.2 {UpdateGeometryInfo: menu resizing} {
     destroy .t
     set result
 } {50 50 0}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/window.test b/tests/window.test
index 3a1df2b..2de63a0 100644
--- a/tests/window.test
+++ b/tests/window.test
@@ -2,14 +2,13 @@
 # tkWindow.c.  It is organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: window.test,v 1.3 1998/09/14 18:23:53 stanton Exp $
+# RCS: @(#) $Id: window.test,v 1.4 1999/04/16 01:51:44 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -80,13 +79,12 @@ test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
     destroy .f
 } {}
 
-if {[string compare testmenubar [info commands testmenubar]] != 0} {
-    puts "This application hasn't been compiled with the testmenubar command,"
-    puts "therefore I am skipping all of these tests."
-    return
-}
+# Some tests require the testmenubar command
+set ::tcltest::testConfig(testmenubar) \
+	[expr {[info commands testmenubar] != {}}]
 
-test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
+test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \
+	{unixOnly testmenubar} {
     catch {destroy .t}
     toplevel .t -width 300 -height 200
     wm geometry .t +0+0
@@ -96,7 +94,8 @@ test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unix
     update
     # If stacking order isn't handle properly, generates an X error.
 } {}
-test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
+test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} \
+	{unixOnly testmenubar} {
     catch {destroy .t}
     toplevel .t -width 300 -height 200
     wm geometry .t +0+0
@@ -110,11 +109,11 @@ test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unix
     # If stacking order isn't handled properly, generates an X error.
 } {}
 
-test window-4.1 {Tk_NameToWindow procedure} {
+test window-4.1 {Tk_NameToWindow procedure} {testmenubar} {
     catch {destroy .t}
     list [catch {winfo geometry .t} msg] $msg
 } {1 {bad window path name ".t"}}
-test window-4.2 {Tk_NameToWindow procedure} {
+test window-4.2 {Tk_NameToWindow procedure} {testmenubar} {
     catch {destroy .t}
     frame .t -width 100 -height 50
     place .t -x 10 -y 10
@@ -122,7 +121,8 @@ test window-4.2 {Tk_NameToWindow procedure} {
     list [catch {winfo geometry .t} msg] $msg
 } {0 100x50+10+10}
 
-test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
+test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} \
+	{unixOnly testmenubar} {
     catch {destroy .t}
     toplevel .t -width 300 -height 200
     wm geometry .t +0+0
@@ -135,3 +135,19 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unix
     update
     # If stacking order isn't handled properly, generates an X error.
 } {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/winfo.test b/tests/winfo.test
index 826d1e2..82bc261 100644
--- a/tests/winfo.test
+++ b/tests/winfo.test
@@ -3,14 +3,13 @@
 #
 # Copyright (c) 1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winfo.test,v 1.3 1998/09/14 18:23:54 stanton Exp $
+# RCS: @(#) $Id: winfo.test,v 1.4 1999/04/16 01:51:44 stanton Exp $
 
-if {[info procs test] != "test"} {
-    source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
 foreach i [winfo children .] {
@@ -19,6 +18,10 @@ foreach i [winfo children .] {
 wm geometry . {}
 raise .
 
+# Some tests require the testwrapper command
+set ::tcltest::testConfig(testwrapper) \
+	[expr {[info commands testwrapper] != {}}]
+
 # eatColors --
 # Creates a toplevel window and allocates enough colors in it to
 # use up all the slots in the colormap.
@@ -88,32 +91,33 @@ test winfo-2.7 {"winfo atom" command} {
     winfo atomname -displayof . 2
 } SECONDARY
 
-if {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")} {
-    test winfo-3.1 {"winfo colormapfull" command} {
-	list [catch {winfo colormapfull} msg] $msg
-    } {1 {wrong # args: should be "winfo colormapfull window"}}
-    test winfo-3.2 {"winfo colormapfull" command} {
-	list [catch {winfo colormapfull a b} msg] $msg
-    } {1 {wrong # args: should be "winfo colormapfull window"}}
-    test winfo-3.3 {"winfo colormapfull" command} {
-	list [catch {winfo colormapfull foo} msg] $msg
-    } {1 {bad window path name "foo"}}
-    test winfo-3.4 {"winfo colormapfull" command} {macOrUnix} {
-	eatColors .t {-colormap new}
-	set result [list [winfo colormapfull .] [winfo colormapfull .t]]
-	.t.c delete 34
-	lappend result [winfo colormapfull .t]
-	.t.c create rectangle 30 30 80 80 -fill #441739
-	lappend result [winfo colormapfull .t]
-	.t.c create rectangle 40 40 90 90 -fill #ffeedd
-	lappend result [winfo colormapfull .t]
-	destroy .t.c
-	lappend result [winfo colormapfull .t]
-    } {0 1 0 0 1 0}
-    catch {destroy .t}
-}
+# Some tests require the "pseudocolor" visual class.
+set ::tcltest::testConfig(pseudocolor) \
+	[expr {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")}]
 
+test winfo-3.1 {"winfo colormapfull" command} {pseudocolor} {
+    list [catch {winfo colormapfull} msg] $msg
+} {1 {wrong # args: should be "winfo colormapfull window"}}
+test winfo-3.2 {"winfo colormapfull" command} {pseudocolor} {
+    list [catch {winfo colormapfull a b} msg] $msg
+} {1 {wrong # args: should be "winfo colormapfull window"}}
+test winfo-3.3 {"winfo colormapfull" command} {pseudocolor} {
+    list [catch {winfo colormapfull foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test winfo-3.4 {"winfo colormapfull" command} {macOrUnix pseudocolor} {
+    eatColors .t {-colormap new}
+    set result [list [winfo colormapfull .] [winfo colormapfull .t]]
+    .t.c delete 34
+    lappend result [winfo colormapfull .t]
+    .t.c create rectangle 30 30 80 80 -fill #441739
+    lappend result [winfo colormapfull .t]
+    .t.c create rectangle 40 40 90 90 -fill #ffeedd
+    lappend result [winfo colormapfull .t]
+    destroy .t.c
+    lappend result [winfo colormapfull .t]
+} {0 1 0 0 1 0}
 catch {destroy .t}
+
 toplevel .t -width 550 -height 400
 frame .t.f -width 80 -height 60 -bd 2 -relief raised
 place .t.f -x 50 -y 50
@@ -206,15 +210,9 @@ test winfo-7.6 {"winfo pathname" command} {
 test winfo-7.7 {"winfo pathname" command} {
     winfo pathname -displayof .b [winfo id .]
 } {.}
-
-if {[string compare testwrapper [info commands testwrapper]] == 0} {
-    puts "This application hasn't been compiled with the testwrapper command,"
-    puts "therefore I am skipping all of these tests."
-
-    test winfo-7.8 {"winfo pathname" command} {unixOnly} {
-        winfo pathname [testwrapper .]
-    } {}
-}
+test winfo-7.8 {"winfo pathname" command} {unixOnly testwrapper} {
+    winfo pathname [testwrapper .]
+} {}
 
 test winfo-8.1 {"winfo pointerx" command} {
     catch [winfo pointerx .b]
@@ -317,7 +315,7 @@ proc MakeEmbed {} {
     pack .emb.b -expand yes -fill both
     update
 }
-test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} {
+test winfo-13.1 {root coordinates of embedded toplevel} {
     MakeEmbed
     set z [expr [winfo rootx .emb] == [winfo rootx .con] && \
 		[winfo rooty .emb] == [winfo rooty .con]]
@@ -325,8 +323,8 @@ test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} {
     destroy .con
     set z
 } {1}
-test winfo-13.2 {destroying embedded toplevel} {macOrUnix} {
-    catch {destroy .emb}
+test winfo-13.2 {destroying embedded toplevel} {
+    destroy .emb
     update
     expr [winfo exists .emb.b] || [winfo exists .con]
 } 0
@@ -335,7 +333,7 @@ foreach i [winfo children .] {
     destroy $i
 }
 
-test winfo-13.3 {destroying container window} {macOrUnix} {
+test winfo-13.3 {destroying container window} {
     MakeEmbed
     destroy .con
     update
@@ -349,7 +347,7 @@ foreach i [winfo children .] {
     destroy $i
 }
 
-test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} {
+test winfo-13.4 {[winfo containing] with embedded windows} {
     MakeEmbed
     button .b
     pack .b -expand yes -fill both
@@ -365,3 +363,19 @@ test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} {
 foreach i [winfo children .] {
     catch {destroy $i}
 }
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/xmfbox.test b/tests/xmfbox.test
new file mode 100644
index 0000000..c5b6736
--- /dev/null
+++ b/tests/xmfbox.test
@@ -0,0 +1,153 @@
+# xmfbox.test -- 
+#
+#	This file is a Tcl script to test the file dialog that's used
+#	when the tk_strictMotif flag is set. Because the file dialog
+#	runs in a modal loop, the only way to test it sufficiently is
+#	to call the internal Tcl procedures in xmfbox.tcl directly.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: xmfbox.test,v 1.2 1999/04/16 01:51:44 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+set testPWD [pwd]
+eval destroy [winfo children .]
+catch {unset foo}
+
+catch {unset data foo}
+
+proc cleanup {} {
+    global testPWD
+
+    set err0 [catch {
+	cd $testPWD
+    } msg0]
+
+    set err1 [catch {
+	if [file exists ./~nosuchuser1] {
+	    file delete ./~nosuchuser1
+	}
+    } msg1]
+
+    set err2 [catch {
+	if [file exists ./~nosuchuser2] {
+	    file delete ./~nosuchuser2
+	}
+    } msg2]
+
+    set err3 [catch {
+	if [file exists ./~nosuchuser3] {
+	    file delete ./~nosuchuser3
+	}
+    } msg3]
+
+    set err4 [catch {
+	if [file exists ./~nosuchuser4] {
+	    file delete ./~nosuchuser4
+	}
+    } msg4]
+
+    if {$err0 || $err1 || $err2 || $err3 || $err4} {
+	error [list $msg0 $msg1 $msg2 $msg3 $msg4] 
+    }
+    catch {unset foo}
+    catch {destroy .foo}
+}
+
+test xmfbox-1.1 {tkMotifFDialog_Create, -parent switch} {unixOnly} {
+    catch {unset foo}
+    set x [tkMotifFDialog_Create foo open {-parent .}]
+    catch {destroy $x}
+    set x
+} .foo
+
+test xmfbox-1.2 {tkMotifFDialog_Create, -parent switch} {unixOnly} {
+    catch {unset foo}
+    toplevel .bar
+    set x [tkMotifFDialog_Create foo open {-parent .bar}]
+    catch {destroy $x}
+    catch {destroy .bar}
+    set x
+} .bar.foo
+
+test xmfbox-2.1 {tkMotifFDialog_InterpFilter, ~ in dir names} {unixOnly} {
+    cleanup
+    file mkdir ./~nosuchuser1
+    set x [tkMotifFDialog_Create foo open {}]
+    $foo(fEnt) delete 0 end
+    $foo(fEnt) insert 0 [pwd]/~nosuchuser1
+    set kk [tkMotifFDialog_InterpFilter $x]
+} [list $testPWD/~nosuchuser1 *]
+
+test xmfbox-2.2 {tkMotifFDialog_InterpFilter, ~ in file names} {unixOnly} {
+    cleanup
+    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+    set x [tkMotifFDialog_Create foo open {}]
+    $foo(fEnt) delete 0 end
+    $foo(fEnt) insert 0 [pwd]/~nosuchuser1
+    set kk [tkMotifFDialog_InterpFilter $x]
+} [list $testPWD ./~nosuchuser1]
+
+test xmfbox-2.3 {tkMotifFDialog_Update, ~ in file names} {unixOnly} {
+    cleanup
+    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+    set x [tkMotifFDialog_Create foo open {}]
+    $foo(fEnt) delete 0 end
+    $foo(fEnt) insert 0 [pwd]/~nosuchuser1
+    tkMotifFDialog_InterpFilter $x
+    tkMotifFDialog_Update $x
+    $foo(fList) get end
+} ~nosuchuser1
+
+test xmfbox-2.4 {tkMotifFDialog_LoadFile, ~ in file names} {unixOnly} {
+    cleanup
+    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+    set x [tkMotifFDialog_Create foo open {}]
+    set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
+    expr {$i >= 0}
+} 1
+
+test xmfbox-2.5 {tkMotifFDialog_BrowseFList, ~ in file names} {unixOnly} {
+    cleanup
+    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+    set x [tkMotifFDialog_Create foo open {}]
+    set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
+    $foo(fList) selection clear 0 end
+    $foo(fList) selection set $i
+    tkMotifFDialog_BrowseFList $x
+    $foo(sEnt) get
+} $testPWD/~nosuchuser1
+
+test xmfbox-2.5 {tkMotifFDialog_ActivateFList, ~ in file names} {unixOnly} {
+    cleanup
+    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+    set x [tkMotifFDialog_Create foo open {}]
+    set i [lsearch [$foo(fList) get 0 end] ~nosuchuser1]
+    $foo(fList) selection clear 0 end
+    $foo(fList) selection set $i
+    tkMotifFDialog_BrowseFList $x
+    tkMotifFDialog_ActivateFList $x
+    list $foo(selectPath) $foo(selectFile) $tkPriv(selectFilePath)
+} [list $testPWD ~nosuchuser1 $testPWD/~nosuchuser1]
+
+# cleanup
+cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+