summaryrefslogtreecommitdiffstats
path: root/tests/constraints.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tests/constraints.tcl')
-rw-r--r--tests/constraints.tcl39
1 files changed, 37 insertions, 2 deletions
diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 843ee4d..ac32852 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -138,6 +138,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
+ }
+
}
}
@@ -182,7 +218,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
@@ -242,7 +278,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 . {}