diff options
author | Steve Bennett <steveb@workware.net.au> | 2014-01-04 09:08:27 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2014-01-15 07:14:43 +1000 |
commit | 4cc0ca3896cacbce03a545fc39a106cd75fd394d (patch) | |
tree | 65cf4314c05f440c8058d8241f5ced88be522c99 | |
parent | c6954336d779c7e56aa38ecd6a50ff076ecfabbb (diff) | |
download | jimtcl-4cc0ca3896cacbce03a545fc39a106cd75fd394d.zip jimtcl-4cc0ca3896cacbce03a545fc39a106cd75fd394d.tar.gz jimtcl-4cc0ca3896cacbce03a545fc39a106cd75fd394d.tar.bz2 |
tests: fix tests if tclcompat is not enabled
Signed-off-by: Steve Bennett <steveb@workware.net.au>
-rw-r--r-- | tests/exec.test | 1 | ||||
-rw-r--r-- | tests/pid.test | 10 | ||||
-rw-r--r-- | tests/signal.test | 3 | ||||
-rw-r--r-- | tests/testing.tcl | 18 |
4 files changed, 27 insertions, 5 deletions
diff --git a/tests/exec.test b/tests/exec.test index c55d1f4..50dc706 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -16,6 +16,7 @@ source [file dirname [info script]]/testing.tcl needs cmd exec +needs cmd flush needs cmd after eventloop # Sleep which supports fractions of a second diff --git a/tests/pid.test b/tests/pid.test index 2cc9c32..6a534a5 100644 --- a/tests/pid.test +++ b/tests/pid.test @@ -21,13 +21,15 @@ catch {package require regexp} testConstraint regexp [expr {[info commands regexp] ne {}}] testConstraint socket [expr {[info commands socket] ne {}}] testConstraint getpid [expr {[catch pid] == 0}] +# This is a proxy for tcl || tclcompat +testConstraint pidchan [expr {[info commands fconfigure] ne {}}] file delete test1 test pid-1.1 {pid command} {regexp getpid} { regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid] } 1 -test pid-1.2 {pid command} {regexp socket} { +test pid-1.2 {pid command} {regexp socket pidchan} { set f [open {| echo foo | cat >test1} w] set pids [pid $f] close $f @@ -36,16 +38,16 @@ test pid-1.2 {pid command} {regexp socket} { [regexp {^[0-9]+$} [lindex $pids 1]] \ [expr {[lindex $pids 0] == [lindex $pids 1]}] } {2 1 1 0} -test pid-1.3 {pid command} socket { +test pid-1.3 {pid command} {socket pidchan} { set f [open test1 w] set pids [pid $f] close $f set pids } {} -test pid-1.4 {pid command} { +test pid-1.4 {pid command} pidchan { list [catch {pid a b} msg] $msg } {1 {wrong # args: should be "pid ?channelId?"}} -test pid-1.5 {pid command} { +test pid-1.5 {pid command} pidchan { list [catch {pid gorp} msg] $msg } {1 {can not find channel named "gorp"}} diff --git a/tests/signal.test b/tests/signal.test index 4c08a96..e212501 100644 --- a/tests/signal.test +++ b/tests/signal.test @@ -2,6 +2,7 @@ source [file dirname [info script]]/testing.tcl needs cmd signal needs cmd pid +testConstraint try [expr {[info commands try] ne ""}] test signal-1.1 "catch/throw" { signal handle TERM @@ -77,7 +78,7 @@ test signal-1.7 "clearing ignored signals" { signal check } {} -test signal-1.8 "try/signal" { +test signal-1.8 "try/signal" try { signal handle ALRM try -signal { alarm 0.4 diff --git a/tests/testing.tcl b/tests/testing.tcl index 30aecee..8bfd22d 100644 --- a/tests/testing.tcl +++ b/tests/testing.tcl @@ -74,6 +74,7 @@ lappend auto_path $testdir $bindir [file dirname [pwd]] # For Jim, this is reasonable compatible tcltest proc makeFile {contents name} { set f [open $name w] + stdout puts "About to 'puts $f $contents'" puts $f $contents close $f return $name @@ -83,6 +84,23 @@ proc removeFile {name} { file delete $name } +# In case tclcompat is not selected +if {![exists -proc puts]} { + proc puts {{-nonewline {}} {chan stdout} msg} { + if {${-nonewline} ni {-nonewline {}}} { + ${-nonewline} puts $msg + } else { + $chan puts {*}${-nonewline} $msg + } + } + proc close {chan args} { + $chan close {*}$args + } + proc fileevent {args} { + {*}$args + } +} + proc script_source {script} { lassign [info source $script] f l if {$f ne ""} { |