diff options
Diffstat (limited to 'tests/constraints.tcl')
| -rw-r--r-- | tests/constraints.tcl | 46 |
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 . {} |