diff options
Diffstat (limited to 'tests/constraints.tcl')
| -rw-r--r-- | tests/constraints.tcl | 50 |
1 files changed, 6 insertions, 44 deletions
diff --git a/tests/constraints.tcl b/tests/constraints.tcl index a87499d..01089aa 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,42 +136,6 @@ 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 - } - } } @@ -180,14 +144,10 @@ namespace import -force tk::test::* namespace import -force tcltest::testConstraint testConstraint notAqua [expr {[tk windowingsystem] ne "aqua"}] testConstraint aqua [expr {[tk windowingsystem] eq "aqua"}] -testConstraint x11 [expr {[tk windowingsystem] eq "x11"}] testConstraint nonwin [expr {[tk windowingsystem] ne "win32"}] -testConstraint aquaOrWin32 [expr { - ([tk windowingsystem] eq "win32") || [testConstraint aqua] -}] testConstraint userInteraction 0 testConstraint nonUnixUserInteraction [expr { - [testConstraint userInteraction] || + [testConstraint userInteraction] || ([testConstraint unix] && [testConstraint notAqua]) }] testConstraint haveDISPLAY [info exists env(DISPLAY)] @@ -209,6 +169,7 @@ 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]] @@ -219,7 +180,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 -highlightthickness 1 +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 @@ -279,6 +240,7 @@ 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 . {} |