summaryrefslogtreecommitdiffstats
path: root/tests/constraints.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tests/constraints.tcl')
-rw-r--r--tests/constraints.tcl46
1 files changed, 40 insertions, 6 deletions
diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 01089aa..e0486ff 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -36,7 +36,7 @@ namespace eval tk {
}
namespace eval bg {
- # Manage a background process.
+ # Manage a background process.
# Replace with slave interp or thread?
namespace import ::tcltest::interpreter
namespace import ::tk::test::loadTkCommand
@@ -124,7 +124,7 @@ namespace eval tk {
eval destroy [winfo children .]
}
- namespace export fixfocus
+ namespace export fixfocus
proc fixfocus {} {
catch {destroy .focus}
toplevel .focus
@@ -136,6 +136,42 @@ namespace eval tk {
focus -force .focus.e
destroy .focus
}
+
+
+ namespace export imageInit imageFinish imageCleanup imageNames
+ variable ImageNames
+ proc imageInit {} {
+ variable ImageNames
+ if {![info exists ImageNames]} {
+ set ImageNames [lsort [image names]]
+ }
+ imageCleanup
+ if {[lsort [image names]] ne $ImageNames} {
+ return -code error "IMAGE NAMES mismatch: [image names] != $ImageNames"
+ }
+ }
+ proc imageFinish {} {
+ variable ImageNames
+ if {[lsort [image names]] ne $ImageNames} {
+ return -code error "images remaining: [image names] != $ImageNames"
+ }
+ imageCleanup
+ }
+ proc imageCleanup {} {
+ variable ImageNames
+ foreach img [image names] {
+ if {$img ni $ImageNames} {image delete $img}
+ }
+ }
+ proc imageNames {} {
+ variable ImageNames
+ set r {}
+ foreach img [image names] {
+ if {$img ni $ImageNames} {lappend r $img}
+ }
+ return $r
+ }
+
}
}
@@ -147,7 +183,7 @@ testConstraint aqua [expr {[tk windowingsystem] eq "aqua"}]
testConstraint nonwin [expr {[tk windowingsystem] ne "win32"}]
testConstraint userInteraction 0
testConstraint nonUnixUserInteraction [expr {
- [testConstraint userInteraction] ||
+ [testConstraint userInteraction] ||
([testConstraint unix] && [testConstraint notAqua])
}]
testConstraint haveDISPLAY [info exists env(DISPLAY)]
@@ -169,7 +205,6 @@ testConstraint testembed [llength [info commands testembed]]
testConstraint testfont [llength [info commands testfont]]
testConstraint testmakeexist [llength [info commands testmakeexist]]
testConstraint testmenubar [llength [info commands testmenubar]]
-testConstraint testmenubar [llength [info commands testmenubar]]
testConstraint testmetrics [llength [info commands testmetrics]]
testConstraint testobjconfig [llength [info commands testobjconfig]]
testConstraint testsend [llength [info commands testsend]]
@@ -180,7 +215,7 @@ testConstraint testwrapper [llength [info commands testwrapper]]
# constraint to see what sort of fonts are available
testConstraint fonts 1
destroy .e
-entry .e -width 0 -font {Helvetica -12} -bd 1
+entry .e -width 0 -font {Helvetica -12} -bd 1 -highlightthickness 1
.e insert end a.bcd
if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
testConstraint fonts 0
@@ -240,7 +275,6 @@ namespace import -force tcltest::removeDirectory
namespace import -force tcltest::interpreter
namespace import -force tcltest::testsDirectory
namespace import -force tcltest::cleanupTests
-namespace import -force tcltest::bytestring
deleteWindows
wm geometry . {}