summaryrefslogtreecommitdiffstats
path: root/tests/constraints.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tests/constraints.tcl')
-rw-r--r--tests/constraints.tcl70
1 files changed, 45 insertions, 25 deletions
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 .