diff options
author | dgp <dgp@users.sourceforge.net> | 2002-07-13 00:30:24 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2002-07-13 00:30:24 (GMT) |
commit | 511415799ba6bf2ec3e5d90c57dfbb61da8c6da1 (patch) | |
tree | d8de9e4b9b75ecee4498744836b0d9adee60d3b5 /tests/constraints.tcl | |
parent | c67bb2bfa2e4f3a9aff167a37f0d2bb6f06b67cc (diff) | |
download | tk-511415799ba6bf2ec3e5d90c57dfbb61da8c6da1.zip tk-511415799ba6bf2ec3e5d90c57dfbb61da8c6da1.tar.gz tk-511415799ba6bf2ec3e5d90c57dfbb61da8c6da1.tar.bz2 |
* Converted several files in the test suite for testing by
tcltest 2.1.
Diffstat (limited to 'tests/constraints.tcl')
-rw-r--r-- | tests/constraints.tcl | 27 |
1 files changed, 20 insertions, 7 deletions
diff --git a/tests/constraints.tcl b/tests/constraints.tcl index a6c52da..065e52e 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -3,6 +3,7 @@ package require Tk 8.4 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}] @@ -37,10 +38,9 @@ namespace eval ::tk { proc cleanup {} { variable fd - catch { - puts $fd exit - close $fd - } + # catch in case the background process has closed $fd + catch {puts $fd exit} + catch {close $fd} set fd "" } proc setup args { @@ -75,16 +75,29 @@ namespace eval ::tk { append Data $x } } - proc do {cmd} { + proc do {cmd {block 0}} { variable fd variable Data variable Done + if {$block} { + fileevent $fd readable {} + } puts $fd "[list catch $cmd msg]; update; puts \$msg;\ puts **DONE**; flush stdout" flush $fd - set Done 0 set Data {} - vwait [namespace which -variable Done] + if {$block} { + while {![eof $fd]} { + set line [gets $fd] + if {$line eq "**DONE**"} { + break + } + append Data $line + } + } else { + set Done 0 + vwait [namespace which -variable Done] + } return $Data } } |