summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2002-07-13 20:28:35 (GMT)
committerdgp <dgp@users.sourceforge.net>2002-07-13 20:28:35 (GMT)
commit05961d4dc9e4b65d07feac195998ca0f969b06d9 (patch)
tree83ce372d1ae9d46d27acc5638739bddcbc8e6ba6
parent511415799ba6bf2ec3e5d90c57dfbb61da8c6da1 (diff)
downloadtk-05961d4dc9e4b65d07feac195998ca0f969b06d9.zip
tk-05961d4dc9e4b65d07feac195998ca0f969b06d9.tar.gz
tk-05961d4dc9e4b65d07feac195998ca0f969b06d9.tar.bz2
* Converted more files to tcltest and factored out common code.
-rw-r--r--ChangeLog5
-rw-r--r--tests/constraints.tcl70
-rw-r--r--tests/macEmbed.test88
-rw-r--r--tests/macFont.test15
-rw-r--r--tests/macMenu.test36
-rw-r--r--tests/macWinMenu.test36
-rw-r--r--tests/macscrollbar.test21
-rw-r--r--tests/main.test29
-rw-r--r--tests/menu.test46
-rw-r--r--tests/menuDraw.test39
-rw-r--r--tests/menubut.test55
-rw-r--r--tests/message.test11
-rw-r--r--tests/msgbox.test16
-rw-r--r--tests/obj.test19
-rw-r--r--tests/oldpack.test13
-rw-r--r--tests/option.test22
-rw-r--r--tests/pack.test11
-rw-r--r--tests/panedwindow.test25
-rw-r--r--tests/place.test17
-rw-r--r--tests/raise.test23
-rw-r--r--tests/safe.test13
-rw-r--r--tests/scale.test18
-rw-r--r--tests/scrollbar.test17
-rw-r--r--tests/select.test9
-rw-r--r--tests/send.test14
-rw-r--r--tests/spinbox.test18
-rw-r--r--tests/text.test24
-rw-r--r--tests/textBTree.test9
-rw-r--r--tests/textDisp.test20
-rw-r--r--tests/textImage.test7
-rw-r--r--tests/textIndex.test7
-rw-r--r--tests/textMark.test10
-rw-r--r--tests/textTag.test10
-rw-r--r--tests/textWind.test11
-rw-r--r--tests/tk.test9
-rw-r--r--tests/unixButton.test37
-rw-r--r--tests/unixEmbed.test125
-rw-r--r--tests/unixFont.test7
-rw-r--r--tests/unixMenu.test17
-rw-r--r--tests/unixSelect.test8
-rw-r--r--tests/unixWm.test37
-rw-r--r--tests/util.test15
-rw-r--r--tests/visual.test18
-rw-r--r--tests/visual_bb.test10
-rw-r--r--tests/winButton.test49
-rw-r--r--tests/winClipboard.test11
-rw-r--r--tests/winDialog.test15
-rw-r--r--tests/winFont.test10
-rw-r--r--tests/winMenu.test34
-rw-r--r--tests/winSend.test19
-rw-r--r--tests/winWm.test12
-rw-r--r--tests/window.test17
-rw-r--r--tests/winfo.test36
-rw-r--r--tests/wm.test17
-rw-r--r--tests/xmfbox.test9
55 files changed, 506 insertions, 790 deletions
diff --git a/ChangeLog b/ChangeLog
index c25bedc..1721d8e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2002-07-12 Don Porter <dgp@users.sf.net>
+
+ * tests/constraints.tcl: Converted more files to tcltest and
+ * tests/[m-x]*.test: factored out common code.
+
2002-07-11 Don Porter <dgp@users.sf.net>
* tests/canvPsImg.tcl: Converted several files in the
diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 065e52e..f58cf67 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -1,31 +1,12 @@
package require Tcl 8.4
+
package require Tk 8.4
+tk appname tktest
+wm title . tktest
+
package require tcltest 2.1
-namespace import -force tcltest::testConstraint
-testConstraint userInteraction 0
-testConstraint altDisplay [info exists env(TK_ALT_DISPLAY)]
-testConstraint noExceed [expr {![testConstraint unix]
- || [catch {font actual "\{xyz"}]}]
-testConstraint testImageType [expr {[lsearch [image types] test] >= 0}]
-testConstraint fonts 1
-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)} {
- testConstraint fonts 0
-}
-destroy .e
-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]} {
- testConstraint fonts 0
-}
-namespace eval ::tk {
+namespace eval tk {
if {[namespace exists test]} {
namespace delete test
}
@@ -110,8 +91,47 @@ namespace eval ::tk {
Export bg::setup as setupbg
Export bg::cleanup as cleanupbg
Export bg::do as dobg
+
+ namespace export deleteWindows
+ proc deleteWindows {} {
+ eval destroy [winfo children .]
+ }
}
}
-namespace import -force ::tk::test::*
+namespace import -force tk::test::*
+
+namespace import -force tcltest::testConstraint
+testConstraint userInteraction 0
+testConstraint nonUnixUserInteraction [expr {[testConstraint userInteraction]
+ || [testConstraint unix]}]
+testConstraint altDisplay [info exists env(TK_ALT_DISPLAY)]
+testConstraint noExceed [expr {![testConstraint unix]
+ || [catch {font actual "\{xyz"}]}]
+testConstraint testImageType [expr {[lsearch [image types] test] >= 0}]
+testConstraint fonts 1
+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)} {
+ testConstraint fonts 0
+}
+destroy .e
+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]} {
+ testConstraint fonts 0
+}
+
+eval tcltest::configure $argv
+namespace import -force tcltest::test
+
+deleteWindows
+wm geometry . {}
+raise .
diff --git a/tests/macEmbed.test b/tests/macEmbed.test
index b6c2f68..bd9cdbc 100644
--- a/tests/macEmbed.test
+++ b/tests/macEmbed.test
@@ -6,16 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: macEmbed.test,v 1.5 2001/03/28 17:27:10 dgp Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
-
-eval destroy [winfo children .]
-wm geometry . {}
-raise .
+# RCS: @(#) $Id: macEmbed.test,v 1.6 2002/07/13 20:28:35 dgp Exp $
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} {
catch {destroy .t}
@@ -34,7 +32,7 @@ if {[string compare testembed [info commands testembed]] != 0} {
}
test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly} {
- eval destroy [winfo child .]
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
pack .f1 .f2
@@ -43,7 +41,7 @@ test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly}
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} {macOnly} {
- eval destroy [winfo child .]
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
pack .f1 .f2
@@ -58,9 +56,7 @@ test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {macOnly}
# TkpMakeContainer, or EmbedErrorProc.
test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -71,9 +67,7 @@ test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} {
testembed
} {}
test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
toplevel .t1 -use [winfo id .f1]
@@ -82,9 +76,7 @@ test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} {
testembed
} {}
test macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
toplevel .t1 -use [winfo id .f1]
@@ -95,9 +87,7 @@ test macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} {
} {{} {}}
test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -108,9 +98,7 @@ test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} {
} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
{macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -122,9 +110,7 @@ test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
} {200x200+0+0}
test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
{macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -135,9 +121,7 @@ test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
wm geometry .t1
} {300x100+0+0}
test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
toplevel .t1 -container 1 -width 200 -height 50
set w1 [winfo id .t1]
toplevel .t2 -use $w1
@@ -147,9 +131,7 @@ test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
} {300 80 300x80+0+0}
test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -162,9 +144,7 @@ test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
set x
} {mapped}
test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -178,9 +158,7 @@ test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
} {dead 0}
test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -191,9 +169,7 @@ test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
winfo geometry .t1
} {180x100+0+0}
test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -208,9 +184,7 @@ test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} {
test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
catch {interp delete child}
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -width 200 -height 50
pack .f1 .f2
@@ -232,9 +206,7 @@ test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
catch {interp delete child}
test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
frame .f3 -container 1 -width 200 -height 50
@@ -249,9 +221,7 @@ test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} {
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} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
set w1 [winfo id .f1]
@@ -264,9 +234,7 @@ test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {macOnly} {
} {{{XXX .f1 XXX .t1}} {}}
test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
toplevel .t1 -use [winfo id .f1] -width 150 -height 80
@@ -276,9 +244,7 @@ test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOn
wm geometry .t1
} {150x80+0+0}
test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
toplevel .t1 -use [winfo id .f1] -width 150 -height 80
@@ -290,9 +256,7 @@ test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOn
-foreach w [winfo child .] {
- catch {destroy $w}
-}
+deleteWindows
# cleanup
::tcltest::cleanupTests
diff --git a/tests/macFont.test b/tests/macFont.test
index 972f81d..f4e3083 100644
--- a/tests/macFont.test
+++ b/tests/macFont.test
@@ -10,11 +10,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: macFont.test,v 1.4 2001/09/21 20:38:18 hobbs Exp $
+# RCS: @(#) $Id: macFont.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
catch {destroy .b}
toplevel .b
@@ -39,11 +42,11 @@ proc getsize {} {
return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}
-set ::tcltest::testConfig(gothic) 0
+testConstraint 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
+ testConstraint gothic 1
}
test macFont-1.1 {TkpFontPkgInit} {macOnly} {
diff --git a/tests/macMenu.test b/tests/macMenu.test
index f1ee519..2a36c60 100644
--- a/tests/macMenu.test
+++ b/tests/macMenu.test
@@ -7,24 +7,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: macMenu.test,v 1.6 2001/09/21 20:38:18 hobbs Exp $
+# RCS: @(#) $Id: macMenu.test,v 1.7 2002/07/13 20:28:35 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
-
-set ::tcltest::testConfig(testimage) \
- [expr {[lsearch [image types] test] >= 0}]
-
-proc deleteWindows {} {
- foreach i [winfo children .] {
- catch [destroy $i]
- }
-}
-
-deleteWindows
-wm geometry . {}
-raise .
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test macMenu-1.0 {TkMacUseMenuID} {macOnly} {
# Can't really test TkMacUseMenuID; it's only called on startup.
@@ -184,7 +174,7 @@ test macMenu-8.1 {GetEntryText} {macOnly} {
catch {destroy .m1}
list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
-test macMenu-8.2 {GetEntryText} {macOnly testimage} {
+test macMenu-8.2 {GetEntryText} {macOnly testImageType} {
catch {destroy .m1}
catch {image delete image1}
menu .m1
@@ -1377,7 +1367,7 @@ test macMenu-41.12 {TkpComputeStandardMenuGeometry - indicator} {macOnly} {
.m1 invoke 1
list [update idletasks] [destroy .m1]
} {{} {}}
-test macMenu-41.13 {TkpComputeStandardMenuGeometry - second indicator less or equal } {macOnly testimage} {
+test macMenu-41.13 {TkpComputeStandardMenuGeometry - second indicator less or equal } {macOnly testImageType} {
catch {destroy .m1}
catch {image delete image1}
image create test image1
@@ -1449,7 +1439,7 @@ test macMenu-42.1 {DrawMenuEntryLabel - setting indicatorSpace} {macOnly} {
set tearoff [tk::TearOffMenu .m1]
list [update idletasks] [destroy .m1]
} {{} {}}
-test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testimage} {
+test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testImageType} {
catch {destroy .m1}
catch {image delete image1}
image create test image1
@@ -1458,7 +1448,7 @@ test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testimage} {
set tearoff [tk::TearOffMenu .m1]
list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
-test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} {macOnly testimage} {
+test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} {macOnly testImageType} {
catch {destroy .m1}
catch {eval image delete [image names]}
image create test image1
@@ -1497,7 +1487,7 @@ test macMenu-42.7 {DrawMenuEntryLabel - drawing disabled label} {macOnly} {
set tearoff [tk::TearOffMenu .m1]
list [update idletasks] [destroy .m1]
} {{} {}}
-test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testimage} {
+test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testImageType} {
catch {destroy .m1}
catch {image delete image1}
image create test image1
@@ -1507,7 +1497,7 @@ test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testimage} {
list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
-test macMenu-43.1 {GetMenuLabelGeometry - image} {macOnly testimage} {
+test macMenu-43.1 {GetMenuLabelGeometry - image} {macOnly testImageType} {
catch {destroy .m1}
catch {image delete image1}
menu .m1
diff --git a/tests/macWinMenu.test b/tests/macWinMenu.test
index 2aad508..315f2aa 100644
--- a/tests/macWinMenu.test
+++ b/tests/macWinMenu.test
@@ -6,34 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: macWinMenu.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
-}
-
-# 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 .] {
- catch [destroy $i]
- }
-}
-
-deleteWindows
-wm geometry . {}
-raise .
+# RCS: @(#) $Id: macWinMenu.test,v 1.4 2002/07/13 20:28:35 dgp Exp $
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test macWinMenu-1.1 {PreprocessMenu} {macOrPc nonUnixUserInteraction} {
catch {destroy .m1}
diff --git a/tests/macscrollbar.test b/tests/macscrollbar.test
index 479f8c6..b62c65e 100644
--- a/tests/macscrollbar.test
+++ b/tests/macscrollbar.test
@@ -7,17 +7,15 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: macscrollbar.test,v 1.4 2001/09/21 20:38:18 hobbs Exp $
+# RCS: @(#) $Id: macscrollbar.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
update
# Tests for display and layout
@@ -91,10 +89,7 @@ test macscroll-1.7 {TkpDisplayScrollbar procedure} {macOnly} {
place .s2 -x 0 -y 284 -width 300
} {}
-foreach i [winfo children .] {
- destroy $i
-}
-
+deleteWindows
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/main.test b/tests/main.test
index 0422223..0f25637 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -8,30 +8,33 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: main.test,v 1.5 1999/04/16 01:51:39 stanton Exp $
+# RCS: @(#) $Id: main.test,v 1.6 2002/07/13 20:28:35 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
-test main-1.1 {StdinProc} {unixOnly} {
- catch {removeFile script}
- set fd [open script w]
- puts $fd {
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
+
+test main-1.1 {StdinProc} {unix} {
+ set script [makeFile {
close stdin; exit
- }
- close $fd
- if {[catch {exec $::tcltest::tktest <script} msg]} {
+ } script]
+ if {[catch {exec [interpreter] <$script} msg]} {
set error 1
} else {
set error 0
}
- file delete -force script
+ removeFile script
list $error $msg
} {0 {}}
# cleanup
-catch {removeFile script}
::tcltest::cleanupTests
return
diff --git a/tests/menu.test b/tests/menu.test
index 701a3af..5c157f3 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -5,36 +5,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menu.test,v 1.11 2002/01/31 21:05:27 uid38226 Exp $
+# RCS: @(#) $Id: menu.test,v 1.12 2002/07/13 20:28:35 dgp 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
-}
-
-# Some tests require user interaction on non-unix platform
-set ::tcltest::testConfig(nonUnixUserInteraction) \
- [expr {$::tcltest::testConfig(userInteraction) || \
- $::tcltest::testConfig(unixOnly)}]
-
-set ::tcltest::testConfig(altDisplay) [info exists env(TK_ALT_DISPLAY)]
-
-proc deleteWindows {} {
- foreach i [winfo children .] {
- catch [destroy $i]
- }
-}
-
-deleteWindows
-wm geometry . {}
-raise .
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test menu-1.1 {Tk_MenuCmd procedure} {
list [catch menu msg] $msg
@@ -1377,7 +1355,7 @@ test menu-8.2 {DestroyMenuEntry} {
.m1 add command -image image1a
list [catch {.m1 delete 1} msg] $msg [destroy .m1] [image delete image1a]
} {0 {} {} {}}
-test menu-8.3 {DestroyMenuEntry} {
+test menu-8.3 {DestroyMenuEntry} testImageType {
catch {eval image delete [image names]}
catch {destroy .m1}
image create test image1
@@ -1613,7 +1591,7 @@ test menu-11.17 {ConfigureMenuEntry} {
.m1 add checkbutton
list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
} {0 {} test {}}
-test menu-11.18 {ConfigureMenuEntry} {
+test menu-11.18 {ConfigureMenuEntry} testImageType {
catch {destroy .m1}
catch {image delete image1}
menu .m1
@@ -1621,7 +1599,7 @@ test menu-11.18 {ConfigureMenuEntry} {
image create test image1
list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
} {0 {} {} {}}
-test menu-11.19 {ConfigureMenuEntry} {
+test menu-11.19 {ConfigureMenuEntry} testImageType {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
@@ -1631,7 +1609,7 @@ test menu-11.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-11.20 {ConfigureMenuEntry} {
+test menu-11.20 {ConfigureMenuEntry} testImageType {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
@@ -1641,7 +1619,7 @@ test menu-11.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-11.21 {ConfigureMenuEntry} {
+test menu-11.21 {ConfigureMenuEntry} testImageType {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
diff --git a/tests/menuDraw.test b/tests/menuDraw.test
index ea3503b..d412a23 100644
--- a/tests/menuDraw.test
+++ b/tests/menuDraw.test
@@ -5,29 +5,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menuDraw.test,v 1.4 2001/08/01 16:21:12 dgp 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
-}
-
-proc deleteWindows {} {
- foreach i [winfo children .] {
- catch [destroy $i]
- }
-}
+# RCS: @(#) $Id: menuDraw.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
-deleteWindows
-wm geometry . {}
-raise .
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test menuDraw-1.1 {TkMenuInitializeDrawingFields} {
catch {destroy .m1}
@@ -236,7 +221,7 @@ test menuDraw-10.4 {ComputeMenuGeometry - resize not necessary} {
list [update idletasks] [destroy .m1]
} {{} {}}
-test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} {
+test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} testImageType {
catch {destroy .m1}
catch {eval image delete [image names]}
image create test image1
@@ -248,7 +233,7 @@ test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending}
update idletasks
list [image delete image2] [destroy .m1] [eval image delete [image names]]
} {{} {} {}}
-test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} {
+test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} testImageType {
catch {destroy .m1}
catch {eval image delete [image names]}
image create test image1
@@ -259,7 +244,7 @@ test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} {
set tearoff [tk::TearOffMenu .m1 40 40]
list [image delete image2] [destroy .m1] [eval image delete [image names]]
} {{} {} {}}
-test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} {
+test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} testImageType {
catch {destroy .m1}
catch {eval image delete [image names]}
image create test image1
@@ -388,7 +373,7 @@ test menuDraw-13.5 {TkMenuEventProc - nothing pending} {
list [destroy .m1]
} {{}}
-test menuDraw-14.1 {TkMenuImageProc} {
+test menuDraw-14.1 {TkMenuImageProc} testImageType {
catch {destroy .m1}
catch {image delete image1}
menu .m1
@@ -397,7 +382,7 @@ test menuDraw-14.1 {TkMenuImageProc} {
update idletasks
list [image delete image1] [destroy .m1]
} {{} {}}
-test menuDraw-14.2 {TkMenuImageProc} {
+test menuDraw-14.2 {TkMenuImageProc} testImageType {
catch {destroy .m1}
catch {image delete image1}
menu .m1
diff --git a/tests/menubut.test b/tests/menubut.test
index e1042b1..86db6ae 100644
--- a/tests/menubut.test
+++ b/tests/menubut.test
@@ -6,29 +6,18 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: menubut.test,v 1.6 2001/05/21 14:07:33 tmh Exp $
+# RCS: @(#) $Id: menubut.test,v 1.7 2002/07/13 20:28:35 dgp 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
-}
-
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
@@ -41,7 +30,9 @@ option add *Button.highlightThickness 2
option add *Button.font {Helvetica -12 bold}
eval image delete [image names]
-image create test image1
+if {[testConstraint testImageType]} {
+ image create test image1
+}
menubutton .mb -text "Test"
pack .mb
update
@@ -84,7 +75,7 @@ foreach test {
{-wraplength 100 100 6x {bad screen distance "6x"}}
} {
set name [lindex $test 0]
- test menubutton-1.$i {configuration options} {
+ test menubutton-1.$i {configuration options} testImageType {
.mb configure $name [lindex $test 1]
lindex [.mb configure $name] 4
} [lindex $test 2]
@@ -181,7 +172,7 @@ test menubutton-4.3 {ConfigureMenuButton procedure} {
(processing -width option)
invoked from within
".mb1 configure -width abc"}}
-test menubutton-4.4 {ConfigureMenuButton procedure} {
+test menubutton-4.4 {ConfigureMenuButton procedure} testImageType {
catch {destroy .mb1}
eval image delete [image names]
image create test image1
@@ -209,7 +200,7 @@ test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} {
# XXX Need to add tests for several procedures here. XXX
test menubutton-5.1 {MenuButtonEventProc procedure} {
- eval destroy [winfo children .]
+ deleteWindows
menubutton .mb1 -bg #543210
rename .mb1 .mb2
set x {}
@@ -220,38 +211,38 @@ test menubutton-5.1 {MenuButtonEventProc procedure} {
} {.mb1 #543210 {} {}}
test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} {
- eval destroy [winfo children .]
+ deleteWindows
menubutton .mb1
rename .mb1 {}
list [info command .mb*] [winfo children .]
} {{} {}}
-test menubutton-7.1 {ComputeMenuButtonGeometry procedure} {
+test menubutton-7.1 {ComputeMenuButtonGeometry procedure} testImageType {
catch {destroy .mb}
menubutton .mb -image image1 -bd 4 -highlightthickness 0
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {38 23}
-test menubutton-7.2 {ComputeMenuButtonGeometry procedure} {
+test menubutton-7.2 {ComputeMenuButtonGeometry procedure} testImageType {
catch {destroy .mb}
menubutton .mb -image image1 -bd 1 -highlightthickness 2
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {36 21}
-test menubutton-7.3 {ComputeMenuButtonGeometry procedure} {
+test menubutton-7.3 {ComputeMenuButtonGeometry procedure} testImageType {
catch {destroy .mb}
menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {34 19}
-test menubutton-7.4 {ComputeMenuButtonGeometry procedure} {
+test menubutton-7.4 {ComputeMenuButtonGeometry procedure} testImageType {
catch {destroy .mb}
menubutton .mb -image image1 -bd 2 -relief raised -width 40 \
-highlightthickness 2
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {48 23}
-test menubutton-7.5 {ComputeMenuButtonGeometry procedure} {
+test menubutton-7.5 {ComputeMenuButtonGeometry procedure} testImageType {
catch {destroy .mb}
menubutton .mb -image image1 -bd 2 -relief raised -height 30 \
-highlightthickness 2
@@ -314,7 +305,7 @@ test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {nonPortable fonts} {
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {78 28}
-test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable} {
+test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {testImageType unixOnly nonPortable} {
# The following test is non-portable because the indicator's pixel
# size varies to maintain constant absolute size.
@@ -324,7 +315,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {64 23}
-test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable} {
+test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {testImageType pcOnly nonPortable} {
# The following test is non-portable because the indicator's pixel
# size varies to maintain constant absolute size.
@@ -336,7 +327,7 @@ test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable}
} {65 23}
set l [interp hidden]
-eval destroy [winfo children .]
+deleteWindows
test menubutton-8.1 {menubutton vs hidden commands} {
catch {destroy .mb}
@@ -347,7 +338,7 @@ test menubutton-8.1 {menubutton vs hidden commands} {
} [list {} $l]
eval image delete [image names]
-eval destroy [winfo children .]
+deleteWindows
option clear
# cleanup
diff --git a/tests/message.test b/tests/message.test
index f2c7d5d..a5f52e5 100644
--- a/tests/message.test
+++ b/tests/message.test
@@ -6,11 +6,14 @@
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
#
-# RCS: @(#) $Id: message.test,v 1.1 2000/08/02 01:33:34 ericm Exp $
+# RCS: @(#) $Id: message.test,v 1.2 2002/07/13 20:28:35 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
option add *Message.borderWidth 2
option add *Message.highlightThickness 2
diff --git a/tests/msgbox.test b/tests/msgbox.test
index b37305c..a20d787 100644
--- a/tests/msgbox.test
+++ b/tests/msgbox.test
@@ -5,17 +5,15 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: msgbox.test,v 1.5 2001/08/01 16:21:12 dgp Exp $
+# RCS: @(#) $Id: msgbox.test,v 1.6 2002/07/13 20:28:35 dgp Exp $
#
-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)}]
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test msgbox-1.1 {tk_messageBox command} {
list [catch {tk_messageBox -foo} msg] $msg
diff --git a/tests/obj.test b/tests/obj.test
index f24ff68..bc4618e 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -5,17 +5,14 @@
# 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 $
+# RCS: @(#) $Id: obj.test,v 1.3 2002/07/13 20:28:35 dgp 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 .
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test obj-1.1 {TkGetPixelsFromObj} {
} {}
@@ -31,7 +28,7 @@ test obj-4.1 {SetPixelFromAny} {
-eval destroy [winfo children .]
+deleteWindows
# cleanup
::tcltest::cleanupTests
diff --git a/tests/oldpack.test b/tests/oldpack.test
index e809da5..52e2d4e 100644
--- a/tests/oldpack.test
+++ b/tests/oldpack.test
@@ -7,11 +7,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: oldpack.test,v 1.4 2001/08/21 20:21:36 pspjuth Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+# RCS: @(#) $Id: oldpack.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
# First, test a single window packed in various ways in a parent
diff --git a/tests/option.test b/tests/option.test
index 339d723..173ec37 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -6,11 +6,17 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: option.test,v 1.3 1999/04/16 01:51:40 stanton Exp $
+# RCS: @(#) $Id: option.test,v 1.4 2002/07/13 20:28:35 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
catch {destroy .op1}
catch {destroy .op2}
@@ -185,9 +191,8 @@ test option-14.12 {error conditions} {
list [catch {option get .gorp.gorp a A} msg] $msg
} {1 {bad window path name ".gorp.gorp"}}
-set option1 [file join $::tcltest::testsDir option.file1]
-set option2 [file join $::tcltest::testsDir option.file2]
-set option3 [file join $::tcltest::testsDir option.file3]
+set option1 [file join [testsDirectory] option.file1]
+set option2 [file join [testsDirectory] option.file2]
test option-15.1 {database files} {
list [catch {option read non-existent} msg] $msg
@@ -211,7 +216,8 @@ test option-15.9 {database files} {
} {1 {missing colon on line 2}}
test option-16.1 {ReadOptionFile} {
- set file [open "$option3" w]
+ set option3 [makeFile {} option.file3]
+ set file [open $option3 w]
fconfigure $file -translation crlf
puts $file "*x7: true\n*x8: false"
close $file
diff --git a/tests/pack.test b/tests/pack.test
index 395b3f2..488281a 100644
--- a/tests/pack.test
+++ b/tests/pack.test
@@ -6,11 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: pack.test,v 1.9 2001/09/26 21:36:19 pspjuth Exp $
+# RCS: @(#) $Id: pack.test,v 1.10 2002/07/13 20:28:35 dgp Exp $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- source [file join [pwd] [file dirname [info script]] defs.tcl]
-}
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
# Utility procedures:
diff --git a/tests/panedwindow.test b/tests/panedwindow.test
index 3a88c18..1a25487 100644
--- a/tests/panedwindow.test
+++ b/tests/panedwindow.test
@@ -6,23 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: panedwindow.test,v 1.2 2002/06/19 23:17:17 hobbs Exp $
-
-if {[info tclversion] < 8.4} {
- puts "panedwindow requires Tk 8.4"
- exit
-}
-
-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 .
+# RCS: @(#) $Id: panedwindow.test,v 1.3 2002/07/13 20:28:35 dgp Exp $
+
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
set i 1
panedwindow .p
diff --git a/tests/place.test b/tests/place.test
index 2d25e3c..02d87ac 100644
--- a/tests/place.test
+++ b/tests/place.test
@@ -5,17 +5,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: place.test,v 1.6 2001/09/26 21:36:19 pspjuth Exp $
+# RCS: @(#) $Id: place.test,v 1.7 2002/07/13 20:28:35 dgp 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 .
+package require tcltest 2.1
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
# XXX - This test file is woefully incomplete. At present, only a
# few of the features are tested.
diff --git a/tests/raise.test b/tests/raise.test
index 12b56cf..53bf9b3 100644
--- a/tests/raise.test
+++ b/tests/raise.test
@@ -8,12 +8,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: raise.test,v 1.6 2002/07/13 00:30:25 dgp Exp $
+# RCS: @(#) $Id: raise.test,v 1.7 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
testConstraint testmakeexist [llength [info commands testmakeexist]]
@@ -53,9 +55,7 @@ proc raise_getOrder {} {
# Procedure to set up a collection of top-level windows
proc raise_makeToplevels {} {
- foreach i [winfo child .] {
- destroy $i
- }
+ deleteWindows
foreach i {.raise1 .raise2 .raise3} {
toplevel $i
wm geom $i 150x100+0+0
@@ -63,15 +63,12 @@ proc raise_makeToplevels {} {
}
}
-foreach i [winfo child .] {
- destroy $i
-}
toplevel .raise
wm geom .raise 250x200+0+0
test raise-1.1 {preserve creation order} {
raise_setup
- update
+ tkwait visibility .raise.e
raise_getOrder
} {d d d b c e e e}
test raise-1.2 {preserve creation order} testmakeexist {
@@ -290,9 +287,7 @@ test raise-7.8 {errors in raise/lower commands} {
list [catch {lower . badName4} msg] $msg
} {1 {bad window path name "badName4"}}
-foreach i [winfo child .] {
- destroy $i
-}
+deleteWindows
# cleanup
::tcltest::cleanupTests
diff --git a/tests/safe.test b/tests/safe.test
index b695023..ba483dc 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -6,11 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: safe.test,v 1.8 2002/07/13 00:30:25 dgp Exp $
+# RCS: @(#) $Id: safe.test,v 1.9 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
## NOTE: Any time tests fail here with an error like:
@@ -32,10 +35,6 @@ eval tcltest::configure $argv
## Ensure that any changes that occured to tk.tcl will work or
## are properly prevented in a safe interpreter. -- hobbs
-foreach i [winfo children .] {
- destroy $i
-}
-
# The set of hidden commands is platform dependent:
if {"$tcl_platform(platform)" == "macintosh"} {
diff --git a/tests/scale.test b/tests/scale.test
index ee4981b..fb9ba5d 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -6,22 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: scale.test,v 1.11 2002/07/13 00:30:25 dgp Exp $
+# RCS: @(#) $Id: scale.test,v 1.12 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
@@ -623,7 +615,7 @@ test scale-11.1 {ScaleEventProc procedure} {
set x
} {initial 1 0 {}}
test scale-11.2 {ScaleEventProc procedure} {
- eval destroy [winfo children .]
+ deleteWindows
scale .s1 -bg #543210
rename .s1 .s2
set x {}
@@ -634,7 +626,7 @@ test scale-11.2 {ScaleEventProc procedure} {
} {.s1 #543210 {} {}}
test scale-12.1 {ScaleCmdDeletedProc procedure} {
- eval destroy [winfo children .]
+ deleteWindows
scale .s1
rename .s1 {}
list [info command .s*] [winfo children .]
@@ -791,7 +783,7 @@ test scale-15.6 {ScaleVarProc procedure, don't call -command} {
} {untouched 60}
set l [interp hidden]
-eval destroy [winfo children .]
+deleteWindows
test scale-16.1 {scale widget vs hidden commands} {
catch {destroy .s}
diff --git a/tests/scrollbar.test b/tests/scrollbar.test
index 775e045..025df53 100644
--- a/tests/scrollbar.test
+++ b/tests/scrollbar.test
@@ -7,22 +7,19 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: scrollbar.test,v 1.8 2002/07/13 00:30:25 dgp Exp $
+# RCS: @(#) $Id: scrollbar.test,v 1.9 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
## testmetrics is a win/mac only test command
##
testConstraint testmetrics [llength [info commands testmetrics]]
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
update
proc scroll args {
@@ -659,7 +656,7 @@ test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} {
} {1 0 1}
set l [interp hidden]
-eval destroy [winfo children .]
+deleteWindows
test scrollbar-9.1 {scrollbar widget vs hidden commands} {
catch {destroy .s}
diff --git a/tests/select.test b/tests/select.test
index 657786b..0e24c7c 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: select.test,v 1.8 2002/07/13 00:30:25 dgp Exp $
+# RCS: @(#) $Id: select.test,v 1.9 2002/07/13 20:28:35 dgp Exp $
#
# Note: Multiple display selection handling will only be tested if the
@@ -14,16 +14,13 @@
#
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
-namespace import -force tcltest::interpreter
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-eval destroy [winfo child .]
+namespace import -force tcltest::interpreter
global longValue selValue selInfo
diff --git a/tests/send.test b/tests/send.test
index b31f550..c69815f 100644
--- a/tests/send.test
+++ b/tests/send.test
@@ -10,28 +10,18 @@
# 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.6 2002/07/13 00:30:25 dgp Exp $
+# RCS: @(#) $Id: send.test,v 1.7 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-# 'send' is only available on Unix...
testConstraint xhost [llength [auto_execok xhost]]
testConstraint testsend [llength [info commands testsend]]
-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.
diff --git a/tests/spinbox.test b/tests/spinbox.test
index 41ca9f8..0a576d3 100644
--- a/tests/spinbox.test
+++ b/tests/spinbox.test
@@ -4,22 +4,14 @@
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: spinbox.test,v 1.2 2002/07/13 00:30:25 dgp Exp $
+# RCS: @(#) $Id: spinbox.test,v 1.3 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
proc scroll args {
global scrollInfo
@@ -1083,7 +1075,7 @@ test spinbox-11.1 {SpinboxEventProc procedure} {
update
} {}
test spinbox-11.2 {SpinboxEventProc procedure} {
- eval destroy [winfo children .]
+ deleteWindows
spinbox .e1 -fg #112233
rename .e1 .e2
set x {}
@@ -1094,7 +1086,7 @@ test spinbox-11.2 {SpinboxEventProc procedure} {
} {.e1 #112233 {} {}}
test spinbox-12.1 {SpinboxCmdDeletedProc procedure} {
- eval destroy [winfo children .]
+ deleteWindows
button .e1 -text "xyz_123"
rename .e1 {}
list [info command .e*] [winfo children .]
@@ -1295,7 +1287,7 @@ test spinbox-17.4 {SpinboxUpdateScrollbar procedure} {
(horizontal scrolling command executed by .e)}}
set l [interp hidden]
-eval destroy [winfo children .]
+deleteWindows
test spinbox-18.1 {Spinbox widget vs hiding} {
destroy .e
diff --git a/tests/text.test b/tests/text.test
index 7ae80a0..0ea9165 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -6,18 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: text.test,v 1.17 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: text.test,v 1.18 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-eval destroy [winfo child .]
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
@@ -1196,13 +1192,13 @@ test text-20.65 {TextSearchCmd, unicode with non-text segments} {
} {1.3 3}
test text-20.66 {TextSearchCmd, hidden text does not affect match index} {
- eval destroy [winfo child .]
+ deleteWindows
pack [text .t2]
.t2 insert end "12345H7890"
.t2 search 7 1.0
} 1.6
test text-20.67 {TextSearchCmd, hidden text does not affect match index} {
- eval destroy [winfo child .]
+ deleteWindows
pack [text .t2]
.t2 insert end "12345H7890"
.t2 tag configure hidden -elide true
@@ -1210,13 +1206,13 @@ test text-20.67 {TextSearchCmd, hidden text does not affect match index} {
.t2 search 7 1.0
} 1.6
test text-20.68 {TextSearchCmd, hidden text does not affect match index} {
- eval destroy [winfo child .]
+ deleteWindows
pack [text .t2]
.t2 insert end "foobar\nbarbaz\nbazboo"
.t2 search boo 1.0
} 3.3
test text-20.69 {TextSearchCmd, hidden text does not affect match index} {
- eval destroy [winfo child .]
+ deleteWindows
pack [text .t2]
.t2 insert end "foobar\nbarbaz\nbazboo"
.t2 tag configure hidden -elide true
@@ -1249,7 +1245,7 @@ test text-20.72 {TextSearchCmd, -regexp -nocase searches} {
set res
} 1.0
-eval destroy [winfo child .]
+deleteWindows
text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
pack .t2
.t2 insert end "1\t2\t3\t4\t55.5"
@@ -1287,7 +1283,7 @@ test text-21.7 {TkTextGetTabs procedure} {
list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
} {1 {bad screen distance "!44"}}
-eval destroy [winfo child .]
+deleteWindows
text .t
pack .t
.t insert 1.0 "One Line"
@@ -1428,7 +1424,7 @@ test text-22.26 {TextDumpCmd procedure, unicode characters} {
} "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
set l [interp hidden]
-eval destroy [winfo children .]
+deleteWindows
test text-23.1 {text widget vs hidden commands} {
catch {destroy .t}
@@ -1577,7 +1573,7 @@ test text-25.13 {-maxundo configuration option} {
.t get 1.0 end
} "line 1\n\n"
-eval destroy [winfo child .]
+deleteWindows
option clear
# cleanup
diff --git a/tests/textBTree.test b/tests/textBTree.test
index 9088f28..7578536 100644
--- a/tests/textBTree.test
+++ b/tests/textBTree.test
@@ -8,11 +8,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textBTree.test,v 1.4 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: textBTree.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
catch {destroy .t}
text .t
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 64be19e..4e7674f 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -6,19 +6,18 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textDisp.test,v 1.6 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: textDisp.test,v 1.7 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
-namespace import -force tcltest::interpreter
-namespace import -force tcltest::makeFile
-namespace import -force tcltest::removeFile
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
+
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
# The procedure below is used as the scrolling command for the text;
# it just saves the scrolling information in a variable "scrollInfo".
@@ -45,9 +44,6 @@ option add *Text.highlightThickness 2
# because some window managers don't allow the overall width of a window
# to get very narrow.
-foreach i [winfo child .] {
- destroy $i
-}
frame .f -width 100 -height 20
pack append . .f left
@@ -2862,9 +2858,7 @@ test textDisp-29.3 {miscellaneous: lines wrap but are still too long} {fonts} {
list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
} {{0.536667 1} 300x50+-156+18 {}}
-foreach i [winfo children .] {
- catch {destroy $i}
-}
+deleteWindows
option clear
# cleanup
diff --git a/tests/textImage.test b/tests/textImage.test
index 1698763..f75ce8a 100644
--- a/tests/textImage.test
+++ b/tests/textImage.test
@@ -7,20 +7,17 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textImage.test,v 1.4 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: textImage.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
# One time setup. Create a font to insure the tests are font metric invariant.
-wm geometry . {}
catch {destroy .t}
font create test_font -family courier -size 14
text .t -font test_font
diff --git a/tests/textIndex.test b/tests/textIndex.test
index 2973c8b..98f81bb 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -6,17 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textIndex.test,v 1.6 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: textIndex.test,v 1.7 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
# Some tests require the testtext command
testConstraint testtext [llength [info commands testtext]]
diff --git a/tests/textMark.test b/tests/textMark.test
index 6eae772..af1dc4d 100644
--- a/tests/textMark.test
+++ b/tests/textMark.test
@@ -6,12 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textMark.test,v 1.4 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: textMark.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
catch {destroy .t}
testConstraint courier12 [expr {[catch {
diff --git a/tests/textTag.test b/tests/textTag.test
index d0797f5..da86a7a 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -6,12 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textTag.test,v 1.5 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: textTag.test,v 1.6 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
catch {destroy .t}
testConstraint courier12 [expr {[catch {
diff --git a/tests/textWind.test b/tests/textWind.test
index 43aefff..c7093ca 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -6,21 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textWind.test,v 1.4 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: textWind.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-foreach i [winfo child .] {
- catch {destroy $i}
-}
-
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
diff --git a/tests/tk.test b/tests/tk.test
index 9423f15..38414ee 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -5,11 +5,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2002 ActiveState Corporation.
#
-# RCS: @(#) $Id: tk.test,v 1.7 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: tk.test,v 1.8 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test tk-1.1 {tk command: general} {
list [catch {tk} msg] $msg
diff --git a/tests/unixButton.test b/tests/unixButton.test
index 6b1bcbb..85f9259 100644
--- a/tests/unixButton.test
+++ b/tests/unixButton.test
@@ -8,23 +8,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixButton.test,v 1.4 2002/07/12 13:40:59 dgp Exp $
+# RCS: @(#) $Id: unixButton.test,v 1.5 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
@@ -58,7 +49,7 @@ pack .l .b .c .r
update
test unixbutton-1.1 {TkpComputeButtonGeometry procedure} {unix testImageType} {
- eval destroy [winfo children .]
+ deleteWindows
image create test image1
image1 changed 0 0 0 0 60 40
label .b1 -image image1 -bd 4 -padx 0 -pady 2
@@ -73,7 +64,7 @@ test unixbutton-1.1 {TkpComputeButtonGeometry procedure} {unix testImageType} {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {68 48 74 54 112 52 112 52}
test unixbutton-1.2 {TkpComputeButtonGeometry procedure} unix {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -bitmap question -bd 3 -padx 0 -pady 2
button .b2 -bitmap question -bd 3 -padx 0 -pady 2
checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1
@@ -86,7 +77,7 @@ test unixbutton-1.2 {TkpComputeButtonGeometry procedure} unix {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {23 33 29 39 54 37 54 37}
test unixbutton-1.3 {TkpComputeButtonGeometry procedure} unix {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -bitmap question -bd 3 -highlightthickness 4
button .b2 -bitmap question -bd 3 -highlightthickness 0
checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \
@@ -101,7 +92,7 @@ test unixbutton-1.3 {TkpComputeButtonGeometry procedure} unix {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {31 41 25 35 25 35 25 35}
test unixbutton-1.4 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold}
button .b2 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold}
checkbutton .b3 -text Xagqpim -padx 1 -pady 1 -font {Helvetica -18 bold}
@@ -114,21 +105,21 @@ test unixbutton-1.4 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts
[winfo reqwidth .b4] [winfo reqheight .b4]
} {82 29 88 35 114 31 121 29}
test unixbutton-1.5 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} {
- eval destroy [winfo children .]
+ deleteWindows
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]
} {136 88}
test unixbutton-1.6 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} {
- eval destroy [winfo children .]
+ deleteWindows
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]
} {231 46}
test unixbutton-1.7 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2
@@ -141,7 +132,7 @@ test unixbutton-1.7 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts
[winfo reqwidth .b4] [winfo reqheight .b4]
} {74 22 60 84 168 38 61 22}
test unixbutton-1.8 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts} {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
-highlightthickness 4
button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \
@@ -157,22 +148,22 @@ test unixbutton-1.8 {TkpComputeButtonGeometry procedure} {unix nonPortable fonts
[winfo reqwidth .b4] [winfo reqheight .b4]
} {62 30 56 24 58 22 62 22}
test unixbutton-1.9 {TkpComputeButtonGeometry procedure} unix {
- eval destroy [winfo children .]
+ deleteWindows
button .b2 -bitmap question -default active
list [winfo reqwidth .b2] [winfo reqheight .b2]
} {37 47}
test unixbutton-1.10 {TkpComputeButtonGeometry procedure} unix {
- eval destroy [winfo children .]
+ deleteWindows
button .b2 -bitmap question -default normal
list [winfo reqwidth .b2] [winfo reqheight .b2]
} {37 47}
test unixbutton-1.11 {TkpComputeButtonGeometry procedure} unix {
- eval destroy [winfo children .]
+ deleteWindows
button .b2 -bitmap question -default disabled
list [winfo reqwidth .b2] [winfo reqheight .b2]
} {27 37}
-eval destroy [winfo children .]
+deleteWindows
# cleanup
::tcltest::cleanupTests
diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test
index 851cba6..8b3cede 100644
--- a/tests/unixEmbed.test
+++ b/tests/unixEmbed.test
@@ -6,21 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixEmbed.test,v 1.9 2002/07/12 13:40:59 dgp Exp $
+# RCS: @(#) $Id: unixEmbed.test,v 1.10 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-eval destroy [winfo children .]
-wm geometry . {}
-raise .
setupbg
dobg {wm withdraw .}
@@ -101,7 +94,7 @@ test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {unix nonPortab
testConstraint testembed [llength [info commands testembed]]
test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {unix testembed} {
- eval destroy [winfo child .]
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
pack .f1 .f2
@@ -113,7 +106,7 @@ test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {unix te
}
} {{{XXX {} {} .t}} 0}
test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} {unix testembed} {
- eval destroy [winfo child .]
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
pack .f1 .f2
@@ -127,7 +120,7 @@ test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} {unix te
}
} {{XXX {} {} .t2} {XXX {} {} .t1}}
test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app} {unix testembed} {
- eval destroy [winfo child .]
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
pack .f1 .f2
@@ -140,9 +133,7 @@ test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app}
# TkpMakeContainer, or EmbedErrorProc.
test unixEmbed-2.1 {EmbeddedEventProc procedure} {unix testembed} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -158,9 +149,7 @@ test unixEmbed-2.1 {EmbeddedEventProc procedure} {unix testembed} {
}
} {}
test unixEmbed-2.2 {EmbeddedEventProc procedure} {unix testembed} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -173,9 +162,7 @@ test unixEmbed-2.2 {EmbeddedEventProc procedure} {unix testembed} {
}
} {}
test unixEmbed-2.3 {EmbeddedEventProc procedure} {unix testembed} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
toplevel .t1 -use [winfo id .f1]
@@ -184,9 +171,7 @@ test unixEmbed-2.3 {EmbeddedEventProc procedure} {unix testembed} {
testembed
} {}
test unixEmbed-2.4 {EmbeddedEventProc procedure} {unix testembed} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
toplevel .t1 -use [winfo id .f1]
@@ -199,9 +184,7 @@ test unixEmbed-2.4 {EmbeddedEventProc procedure} {unix testembed} {
test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} \
{unix testembed nonPortable} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -214,9 +197,7 @@ test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} \
list $x [testembed]
} {{{XXX .f1 {} {}}} {{XXX .f1 XXX {}}}}
test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
toplevel .t1 -container 1
wm geometry .t1 +0+0
toplevel .t2 -use [winfo id .t1] -bg red
@@ -224,9 +205,7 @@ test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} unix {
wm geometry .t2
} {200x200+0+0}
test unixEmbed-3.2 {ContainerEventProc procedure, disallow position changes} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -242,9 +221,7 @@ test unixEmbed-3.2 {ContainerEventProc procedure, disallow position changes} uni
}
} {200x200+0+0}
test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -260,9 +237,7 @@ test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} uni
}
} {300x100+0+0}
test unixEmbed-3.4 {ContainerEventProc procedure, geometry requests} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -278,9 +253,7 @@ test unixEmbed-3.4 {ContainerEventProc procedure, geometry requests} unix {
list [winfo width .f1] [winfo height .f1] [dobg {wm geometry .t1}]
} {300 80 300x80+0+0}
test unixEmbed-3.5 {ContainerEventProc procedure, map requests} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -298,9 +271,7 @@ test unixEmbed-3.5 {ContainerEventProc procedure, map requests} unix {
}
} {mapped}
test unixEmbed-3.6 {ContainerEventProc procedure, destroy events} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -319,9 +290,7 @@ test unixEmbed-3.6 {ContainerEventProc procedure, destroy events} unix {
} {dead 0}
test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -339,9 +308,7 @@ test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} unix {
}
} {180x100+0+0}
test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} {unix testembed} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -356,9 +323,7 @@ test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} {unix testembe
} {{{XXX .f1 XXX {}}} {}}
test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -374,9 +339,7 @@ test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} unix {
dobg {set x}
} {{focus in .t1}}
test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -393,9 +356,7 @@ test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} unix {
update
} {}
test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -415,9 +376,7 @@ test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} unix {
} {{{focus in .t1}} {{focus in .t1} {focus out .t1}}}
test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -435,9 +394,7 @@ test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} unix {
}
} {{{configure .t1 300 120}} 300x120+0+0}
test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
place .f1 -width 200 -height 200
dobg "set w1 [winfo id .f1]"
@@ -459,9 +416,7 @@ test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} unix {
# Can't think up any tests for TkpGetOtherWindow procedure.
test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -484,9 +439,7 @@ test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} unix {
list $x $y
} {{{key a 1}} {}}
test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -512,9 +465,7 @@ test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width
} {{} {{key b}}}
test unixEmbed-8.1 {TkpClaimFocus procedure} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -width 200 -height 50
pack .f1 .f2
@@ -536,9 +487,7 @@ test unixEmbed-8.1 {TkpClaimFocus procedure} unix {
} {{{} .t1} .f1}
test unixEmbed-8.2 {TkpClaimFocus procedure} unix {
catch {interp delete child}
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -width 200 -height 50
pack .f1 .f2
@@ -560,9 +509,7 @@ test unixEmbed-8.2 {TkpClaimFocus procedure} unix {
catch {interp delete child}
test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} {unix testembed} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
frame .f3 -container 1 -width 200 -height 50
@@ -577,9 +524,7 @@ test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} {unix testemb
set x
} {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} {unix testembed} {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
dobg "set w1 [winfo id .f1]"
@@ -594,9 +539,7 @@ test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} {unix teste
} {{{XXX {} {} .t1}} {}}
test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
toplevel .t1 -use [winfo id .f1] -width 150 -height 80
@@ -606,9 +549,7 @@ test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix
wm geometry .t1
} {150x80+0+0}
test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix {
- foreach w [winfo child .] {
- catch {destroy $w}
- }
+ deleteWindows
frame .f1 -container 1 -width 200 -height 50
pack .f1
toplevel .t1 -use [winfo id .f1] -width 150 -height 80
@@ -619,9 +560,7 @@ test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} unix
} {70x300+0+0}
# cleanup
-foreach w [winfo child .] {
- catch {destroy $w}
-}
+deleteWindows
cleanupbg
::tcltest::cleanupTests
return
diff --git a/tests/unixFont.test b/tests/unixFont.test
index 16d2bf8..420bf13 100644
--- a/tests/unixFont.test
+++ b/tests/unixFont.test
@@ -12,17 +12,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixFont.test,v 1.6 2002/07/12 13:40:59 dgp Exp $
+# RCS: @(#) $Id: unixFont.test,v 1.7 2002/07/13 20:28:35 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
testConstraint hasArial 1
testConstraint hasCourierNew 1
diff --git a/tests/unixMenu.test b/tests/unixMenu.test
index ed4a048..7592921 100644
--- a/tests/unixMenu.test
+++ b/tests/unixMenu.test
@@ -7,27 +7,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixMenu.test,v 1.6 2002/07/12 13:41:00 dgp Exp $
+# RCS: @(#) $Id: unixMenu.test,v 1.7 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-proc deleteWindows {} {
- foreach i [winfo children .] {
- catch [destroy $i]
- }
-}
-
-deleteWindows
-wm geometry . {}
-raise .
test unixMenu-1.1 {TkpNewMenu - normal menu} unix {
catch {destroy .m1}
diff --git a/tests/unixSelect.test b/tests/unixSelect.test
index 84c4cc4..cc93902 100644
--- a/tests/unixSelect.test
+++ b/tests/unixSelect.test
@@ -9,18 +9,14 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: unixSelect.test,v 1.3 2002/07/12 13:41:00 dgp Exp $
+# RCS: @(#) $Id: unixSelect.test,v 1.4 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
-
-eval destroy [winfo child .]
global longValue selValue selInfo
diff --git a/tests/unixWm.test b/tests/unixWm.test
index 1896e75..7bdd746 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -7,19 +7,18 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: unixWm.test,v 1.21 2002/07/12 21:08:49 dgp Exp $
+# RCS: @(#) $Id: unixWm.test,v 1.22 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testsDirectory
namespace import -force tcltest::configure
-namespace import -force tcltest::interpreter
-namespace import -force tcltest::makeFile
-namespace import -force tcltest::removeFile
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
+
+namespace import -force tcltest::interpreter
+namespace import -force tcltest::makeFile
+namespace import -force tcltest::removeFile
proc sleep ms {
global x
@@ -30,9 +29,7 @@ proc sleep ms {
# Procedure to set up a collection of top-level windows
proc makeToplevels {} {
- foreach i [winfo child .] {
- destroy $i
- }
+ deleteWindows
foreach i {.raise1 .raise2 .raise3} {
toplevel $i
wm geom $i 150x100+0+0
@@ -1719,12 +1716,10 @@ test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} {
[expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y]
} {52 7 12 62}
-foreach w [winfo children .] {
- catch {destroy $w}
-}
+deleteWindows
wm iconify .
test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} {
- eval destroy [winfo children .]
+ deleteWindows
toplevel .t -width 300 -height 400 -bg green
wm geom .t +40+0
tkwait visibility .t
@@ -1744,7 +1739,7 @@ test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} {
[winfo containing [expr $x + 220] [expr $y + 250]]
} {{} {} .t {} .t2 .t2 {} .t}
test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} {
- eval destroy [winfo children .]
+ deleteWindows
toplevel .t -width 300 -height 400 -bg yellow
wm geom .t +0+50
tkwait visibility .t
@@ -1766,7 +1761,7 @@ test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and
[winfo containing [expr $x +150] [expr $y + 450]]
} {{} {} .t .t .t2 .t2 .t {}}
test unixWm-50.3 {Tk_CoordsToWindow procedure, finding a toplevel with embedding} {
- eval destroy [winfo children .]
+ deleteWindows
toplevel .t -width 300 -height 400 -bg blue
wm geom .t +0+50
frame .t.f -container 1
@@ -1804,7 +1799,7 @@ test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} {
set result
} {{} .}
test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenubar} {
- eval destroy [winfo children .]
+ deleteWindows
toplevel .t -width 300 -height 400 -bd 2 -relief raised
frame .t.f -width 150 -height 120 -bg green
place .t.f -x 10 -y 150
@@ -1826,7 +1821,7 @@ test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenu
[winfo containing [expr $x + 12] [expr $y + 152]]
} {{} .t.menu .t.menu .t.menu.f .t .t .t.f}
test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} {
- eval destroy [winfo children .]
+ deleteWindows
toplevel .t -width 300 -height 400 -bg orange
wm geom .t +0+50
frame .t.f -container 1
@@ -1902,7 +1897,7 @@ test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} {
update
lappend result [winfo containing 100 100]
} {.t.f .t}
-eval destroy [winfo children .]
+deleteWindows
wm deiconify .
# No tests for UpdateVRootGeometry, Tk_GetVRootGeometry,
@@ -1959,9 +1954,7 @@ test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
list $result [winfo containing [winfo rootx .raise2] \
[winfo rooty .raise2]]
} {.raise1 .raise3}
-foreach w [winfo children .] {
- catch {destroy $w}
-}
+deleteWindows
test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} {
catch {destroy .t}
toplevel .t -width 200 -height 200 -bg green
diff --git a/tests/util.test b/tests/util.test
index bf89528..f9ee697 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -6,17 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: util.test,v 1.4 2002/07/12 13:41:00 dgp Exp $
+# RCS: @(#) $Id: util.test,v 1.5 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
-
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
listbox .l -width 20 -height 5 -relief sunken -bd 2
pack .l
diff --git a/tests/visual.test b/tests/visual.test
index 6863abf..28b2d22 100644
--- a/tests/visual.test
+++ b/tests/visual.test
@@ -7,17 +7,15 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: visual.test,v 1.4 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: visual.test,v 1.5 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
update
# eatColors --
@@ -304,9 +302,7 @@ if {$other != {}} {
} {}
}
-foreach w [winfo child .] {
- destroy $w
-}
+deleteWindows
rename eatColors {}
rename colorsFree {}
diff --git a/tests/visual_bb.test b/tests/visual_bb.test
index 480026c..5d99d3b 100644
--- a/tests/visual_bb.test
+++ b/tests/visual_bb.test
@@ -6,18 +6,16 @@
# 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.5 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: visual_bb.test,v 1.6 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-namespace import -force tcltest::testsDirectory
-namespace import -force tcltest::cleanupTests
namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
-eval configure $argv
+
+namespace import -force tcltest::cleanupTests
set auto_path ". $auto_path"
wm title . "Visual Tests for Tk"
diff --git a/tests/winButton.test b/tests/winButton.test
index 0d890ca..5e6214c 100644
--- a/tests/winButton.test
+++ b/tests/winButton.test
@@ -8,25 +8,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winButton.test,v 1.7 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: winButton.test,v 1.8 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
-
-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
-}
-
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
proc bogusTrace args {
error "trace aborted"
@@ -35,7 +24,9 @@ catch {unset value}
catch {unset value2}
eval image delete [image names]
-image create test image1
+if {[testConstraint testImageType]} {
+ image create test image1
+}
label .l -text Label
button .b -text Button
checkbutton .c -text Checkbutton
@@ -43,8 +34,8 @@ radiobutton .r -text Radiobutton
pack .l .b .c .r
update
-test winbutton-1.1 {TkpComputeButtonGeometry procedure} {pcOnly} {
- eval destroy [winfo children .]
+test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType pcOnly} {
+ deleteWindows
image create test image1
image1 changed 0 0 0 0 60 40
label .b1 -image image1 -bd 4 -padx 0 -pady 2
@@ -61,7 +52,7 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} {pcOnly} {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {68 48 70 50 90 52 90 52}
test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -bitmap question -bd 3 -padx 0 -pady 2
button .b2 -bitmap question -bd 3 -padx 0 -pady 2
checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1
@@ -76,7 +67,7 @@ test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {23 33 25 35 45 37 45 37}
test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -bitmap question -bd 3 -highlightthickness 4
button .b2 -bitmap question -bd 3 -highlightthickness 0
checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \
@@ -92,7 +83,7 @@ test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {31 41 23 33 27 37 27 37}
test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
- eval destroy [winfo children .]
+ deleteWindows
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}
checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8}
@@ -105,21 +96,21 @@ test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {58 24 67 33 88 30 90 28}
test winbutton-1.5 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
- eval destroy [winfo children .]
+ deleteWindows
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} {pcOnly nonPortable} {
- eval destroy [winfo children .]
+ deleteWindows
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} {pcOnly nonPortable} {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2
@@ -132,7 +123,7 @@ test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {74 24 67 97 174 46 64 28}
test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
- eval destroy [winfo children .]
+ deleteWindows
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
-highlightthickness 4
button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \
@@ -148,12 +139,12 @@ test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
[winfo reqwidth .b4] [winfo reqheight .b4]
} {66 32 65 31 69 31 71 29}
test winbutton-1.9 {TkpComputeButtonGeometry procedure} {pcOnly} {
- eval destroy [winfo children .]
+ deleteWindows
button .b2 -bitmap question -default normal
list [winfo reqwidth .b2] [winfo reqheight .b2]
} {23 33}
# cleanup
-eval destroy [winfo children .]
+deleteWindows
::tcltest::cleanupTests
return
diff --git a/tests/winClipboard.test b/tests/winClipboard.test
index 078a2be..593c7da 100644
--- a/tests/winClipboard.test
+++ b/tests/winClipboard.test
@@ -10,13 +10,16 @@
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winClipboard.test,v 1.10 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: winClipboard.test,v 1.11 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
namespace import -force tcltest::bytestring
-eval tcltest::configure $argv
# Note that these tests may fail if another application is grabbing the
# clipboard (e.g. an X server)
diff --git a/tests/winDialog.test b/tests/winDialog.test
index bebfe08..9f49f28 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -6,20 +6,19 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 ActiveState Corporation.
#
-# RCS: @(#) $Id: winDialog.test,v 1.8 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: winDialog.test,v 1.9 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
testConstraint testwinevent [llength [info commands testwinevent]]
catch {testwinevent debug 1}
-eval destroy [winfo children .]
-wm geometry . {}
-raise .
-
proc start {arg} {
set ::tk_dialog 0
set ::iter_after 0
diff --git a/tests/winFont.test b/tests/winFont.test
index 0341d86..de0f546 100644
--- a/tests/winFont.test
+++ b/tests/winFont.test
@@ -10,11 +10,15 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winFont.test,v 1.7 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: winFont.test,v 1.8 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
catch {destroy .b}
catch {font delete xyz}
diff --git a/tests/winMenu.test b/tests/winMenu.test
index afa5ca0..9e79c33 100644
--- a/tests/winMenu.test
+++ b/tests/winMenu.test
@@ -7,28 +7,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winMenu.test,v 1.5 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: winMenu.test,v 1.6 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
-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
-}
-
-proc deleteWindows {} {
- foreach i [winfo children .] {
- catch [destroy $i]
- }
-}
-
-deleteWindows
-wm geometry . {}
-raise .
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
test winMenu-1.1 {GetNewID} {pcOnly} {
catch {destroy .m1}
@@ -80,7 +66,7 @@ test winMenu-6.1 {GetEntryText} {pcOnly} {
catch {destroy .m1}
list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
-test winMenu-6.2 {GetEntryText} {pcOnly} {
+test winMenu-6.2 {GetEntryText} {testImageType pcOnly} {
catch {destroy .m1}
catch {image delete image1}
menu .m1
@@ -832,7 +818,7 @@ test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} {
list [update] [destroy .m1]
} {{} {}}
-test winMenu-30.1 {GetMenuLabelGeometry - image} {pcOnly} {
+test winMenu-30.1 {GetMenuLabelGeometry - image} {testImageType pcOnly} {
catch {destroy .m1}
catch {image delete image1}
menu .m1
@@ -966,7 +952,7 @@ test winMenu-32.13 {TkpComputeStandardMenuGeometry - indicator} {pcOnly} {
} {{} {}}
test winMenu-32.14 \
{TkpComputeStandardMenuGeometry - second indicator less or equal} \
- {pcOnly} {
+ {testImageType pcOnly} {
catch {destroy .m1}
catch {image delete image1}
image create test image1
@@ -978,7 +964,7 @@ test winMenu-32.14 \
list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \
- {unixOnly} {
+ {testImageType unixOnly} {
catch {destroy .m1}
catch {image delete image1}
image create test image1
diff --git a/tests/winSend.test b/tests/winSend.test
index 04491df..5a9640b 100644
--- a/tests/winSend.test
+++ b/tests/winSend.test
@@ -7,21 +7,16 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winSend.test,v 1.3 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: winSend.test,v 1.4 2002/07/13 20:28:36 dgp Exp $
-package require Tk 8.4
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-namespace import -force tcltest::interpreter
-eval tcltest::configure $argv
-
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
+namespace import -force tcltest::interpreter
# Compute a script that will load Tk into a child interpreter.
diff --git a/tests/winWm.test b/tests/winWm.test
index 5e81325..7f211bf 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -9,14 +9,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winWm.test,v 1.7 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: winWm.test,v 1.8 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-eval tcltest::configure $argv
-foreach i [winfo children .] {
- catch {destroy $i}
-}
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
# Measure the height of a single menu line
diff --git a/tests/window.test b/tests/window.test
index 3b5ede6..1325fab 100644
--- a/tests/window.test
+++ b/tests/window.test
@@ -5,18 +5,15 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: window.test,v 1.5 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: window.test,v 1.6 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-eval tcltest::configure $argv
-
-foreach i [winfo children .] {
- destroy $i
-}
-wm geometry . {}
-raise .
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
+
update
# XXX This file is woefully incomplete. Right now it only tests
diff --git a/tests/winfo.test b/tests/winfo.test
index 1916cfa..89e6928 100644
--- a/tests/winfo.test
+++ b/tests/winfo.test
@@ -6,18 +6,14 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winfo.test,v 1.7 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: winfo.test,v 1.8 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
-namespace import -force tcltest::testConstraint
-eval tcltest::configure $argv
-
-foreach i [winfo children .] {
- catch {destroy $i}
-}
-wm geometry . {}
-raise .
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
# Some tests require the testwrapper command
testConstraint testwrapper [llength [info commands testwrapper]]
@@ -247,7 +243,7 @@ test winfo-9.5 {"winfo viewable" command} {
list [winfo viewable .f1] [winfo viewable .f1.f2]
} {1 1}
test winfo-9.6 {"winfo viewable" command} {
- eval destroy [winfo child .]
+ deleteWindows
frame .f1 -width 100 -height 100 -relief raised -bd 2
frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
place .f1.f2 -x 0 -y 0
@@ -255,7 +251,7 @@ test winfo-9.6 {"winfo viewable" command} {
list [winfo viewable .f1] [winfo viewable .f1.f2]
} {0 0}
test winfo-9.7 {"winfo viewable" command} {
- eval destroy [winfo child .]
+ deleteWindows
frame .f1 -width 100 -height 100 -relief raised -bd 2
place .f1 -x 0 -y 0
frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
@@ -265,7 +261,7 @@ test winfo-9.7 {"winfo viewable" command} {
list [winfo viewable .f1] [winfo viewable .f1.f2]
} {0 0}
wm deiconify .
-eval destroy [winfo child .]
+deleteWindows
test winfo-10.1 {"winfo visualid" command} {
list [catch {winfo visualid} msg] $msg
@@ -329,9 +325,7 @@ test winfo-13.2 {destroying embedded toplevel} {
expr [winfo exists .emb.b] || [winfo exists .con]
} 0
-foreach i [winfo children .] {
- destroy $i
-}
+deleteWindows
test winfo-13.3 {destroying container window} {
MakeEmbed
@@ -343,9 +337,7 @@ test winfo-13.3 {destroying container window} {
set z
} 0
-foreach i [winfo children .] {
- destroy $i
-}
+deleteWindows
test winfo-13.4 {[winfo containing] with embedded windows} {
MakeEmbed
@@ -381,11 +373,7 @@ test winfo-14.4 {mapped at idle time} {
winfo ismapped .t
} 1
-
-foreach i [winfo children .] {
- catch {destroy $i}
-}
-
+deleteWindows
# cleanup
::tcltest::cleanupTests
return
diff --git a/tests/wm.test b/tests/wm.test
index 6c91e9d..6d576ea 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -7,23 +7,18 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: wm.test,v 1.14 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: wm.test,v 1.15 2002/07/13 20:28:36 dgp Exp $
# This file tests window manager interactions that work across
# platforms. Window manager tests that only work on a specific
# platform should be placed in unixWm.test or winWm.test.
package require tcltest 2.1
-namespace import -force tcltest::test
-
-proc deleteWindows {} {
- foreach i [winfo children .] {
- destroy $i
- }
-}
-
-
-deleteWindows
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
wm deiconify .
if {![winfo ismapped .]} {
diff --git a/tests/xmfbox.test b/tests/xmfbox.test
index 8d7e221..7e5a1c1 100644
--- a/tests/xmfbox.test
+++ b/tests/xmfbox.test
@@ -10,13 +10,16 @@
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
#
-# RCS: @(#) $Id: xmfbox.test,v 1.6 2002/07/12 13:41:01 dgp Exp $
+# RCS: @(#) $Id: xmfbox.test,v 1.7 2002/07/13 20:28:36 dgp Exp $
package require tcltest 2.1
-namespace import -force tcltest::test
+namespace import -force tcltest::configure
+namespace import -force tcltest::testsDirectory
+configure -testdir [file join [pwd] [file dirname [info script]]]
+configure -loadfile [file join [testsDirectory] constraints.tcl]
+tcltest::loadTestedCommands
set testPWD [pwd]
-eval destroy [winfo children .]
catch {unset foo}
catch {unset data foo}