More test speedups

Speed up the timer and exec unit tests with smaller sleeps Signed-off-by: Steve Bennett <steveb@workware.net.au>
author: Steve Bennett <steveb@workware.net.au> 2011-12-13 08:09:21 +1000
committer: Steve Bennett <steveb@workware.net.au> 2011-12-13 08:09:21 +1000
commit: 746797afafa59846346cee306592540b5b3d11fd (patch)
tree: 1a635f67a9f3c35dba07f5abe01f1b3d055ece5d
parent: 6ebf6741a8e25b43637348a2a42800c150c3415b (diff)
download: jimtcl-746797afafa59846346cee306592540b5b3d11fd.zip
jimtcl-746797afafa59846346cee306592540b5b3d11fd.tar.gz
jimtcl-746797afafa59846346cee306592540b5b3d11fd.tar.bz2
4 files changed, 66 insertions, 135 deletions
diff --git a/tests/Makefile b/tests/Makefile
index bf0bf11..2c168ea 100644
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -4,4 +4,4 @@ test:
 	@for i in *.test; do LD_LIBRARY_PATH=..:$(LD_LIBRARY_PATH) $(jimsh) $$i; done
 
 clean:
-	rm -f gorp.file2 cat gorp.file sleep exit wc sh echo test1
+	rm -f gorp.file2 gorp.file sleepx test1 exec.tmp1
diff --git a/tests/exec.test b/tests/exec.test
index 54fe374..02d8c24 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -17,88 +17,21 @@ source [file dirname [info script]]/testing.tcl
 
 needs cmd exec
 
-set f [open echo w]
-puts $f {
-    puts -nonewline [lindex $argv 0]
-    foreach str [lrange $argv 1 end] {
-	puts -nonewline " $str"
-    }
-    puts {}
-    exit
-}
-close $f
-
-set f [open cat w]
-puts $f {
-    if {$argv == {}} {
-	set argv -
-    }
-    foreach name $argv {
-	if {$name == "-"} {
-	    set f stdin
-	} elseif {[catch {open $name r} f] != 0} {
-	    puts stderr $f
-	    continue
-	}
-	while {[eof $f] == 0} {
-	    puts -nonewline [read $f]
-	}
-	if {$f != "stdin"} {
-	    close $f
-	}
-    }
-    exit
-}
-close $f
-
-set f [open wc w]
-puts $f {
-    set data [read stdin]
-    set lines [regsub -all "\n" $data {} dummy]
-    set words [regsub -all "\[^ \t\n]+" $data {} dummy]
-    set chars [string length $data]
-    puts [format "%8.d%8.d%8.d" $lines $words $chars]
-    exit
-}
-close $f
-
-set f [open sh w]
-puts $f {
-    if {[lindex $argv 0] != "-c"} {
-	error "sh: unexpected arguments $argv"
-    }
-    set cmd [lindex $argv 1]
-    lappend cmd ";"
-
-    set newcmd {}
-    
-    foreach arg $cmd {
-	if {$arg == ";"} {
-	    eval exec >@stdout 2>@stderr [list [info nameofexecutable]] $newcmd
-	    set newcmd {}
-	    continue
-	}
-	if {$arg == "1>&2"} {
-	    set arg >@stderr
-	}
-	lappend newcmd $arg
+# Sleep which supports fractions of a second
+if {[info commands sleep] eq {}} {
+    proc sleep {n} {
+	after [expr {int($n * 1000)}]
     }
-    exit
 }
-close $f
-
-set f [open sleep w]
-puts $f {
-    after [expr $argv*100]
-    exit
-}
-close $f
 
-set f [open exit w]
+set f [open sleepx w]
+puts $f "#![info nameofexecutable]"
 puts $f {
-    exit $argv
+    set seconds [lindex $argv 0]
+    after [expr {int($seconds * 1000)}]
 }
 close $f
+catch {exec chmod +x sleepx}
 
 # Basic operations.
 
@@ -303,7 +236,7 @@ test exec-9.2 {commands returning errors} {
     catch {exec echo foo | foo123} msg
 } {1}
 test exec-9.3 {commands returning errors} {
-    list [catch {exec sleep 1 | false | sleep 1} msg]
+    list [catch {exec ./sleepx 0.1 | false | ./sleepx 0.1} msg]
 } {1}
 test exec-9.4 {commands returning errors} jim {
     list [catch {exec false | echo "foo bar"} msg] $msg
@@ -317,7 +250,7 @@ test exec-9.6 {commands returning errors} jim {
 test exec-9.7 {commands returning errors} jim {
     # Note: Use sleep here to ensure the order
     list [catch {exec sh -c "echo error msg 1 1>&2" \
-		     | sh -c "sleep 1; echo error msg 2 1>&2"} msg] $msg
+		     | sh -c "sleep 0.1; echo error msg 2 1>&2"} msg] $msg
 } {0 {error msg 1
 error msg 2}}
 
@@ -389,29 +322,29 @@ close $f
 # Commands in background.
 
 test exec-11.1 {commands in background} {
-    set x [lindex [time {exec sleep 2 &}] 0]
+    set x [lindex [time {exec ./sleepx 0.2 &}] 0]
     expr $x<1000000
 } 1
 test exec-11.2 {commands in background} {
     list [catch {exec echo a &b} msg] $msg
 } {0 {a &b}}
 test exec-11.3 {commands in background} {
-    llength [exec sleep 1 &]
+    llength [exec ./sleepx 0.1 &]
 } 1
 test exec-11.4 {commands in background} {
-    llength [exec sleep 1 | sleep 1 | sleep 1 &]
+    llength [exec ./sleepx 0.1 | ./sleepx 0.1 | ./sleepx 0.1 &]
 } 3
 
 # Make sure that background commands are properly reaped when
 # they eventually die.
 
-exec sleep 3
+exec ./sleepx 0.3
 
 test exec-12.1 {reaping background processes} -body {
     for {set i 0} {$i < 20} {incr i} {
 		exec echo foo > exec.tmp1 &
     }
-    exec sleep 1
+    exec ./sleepx 0.1
     catch {exec ps | fgrep "echo foo" | fgrep -v fgrep | wc} msg
     lindex $msg 0
 } -cleanup {
@@ -479,7 +412,6 @@ test exec-16.1 {flush output before exec} -body {
 Second line
 Third line}
 
-# cleanup
-file delete echo cat wc sh sleep exit
+file delete sleepx
 
 testreport
diff --git a/tests/pid.test b/tests/pid.test
index 404c2b5..d7aacda 100644
--- a/tests/pid.test
+++ b/tests/pid.test
@@ -19,13 +19,14 @@ needs cmd pid posix
 needs cmd exec
 catch {package require regexp}
 testConstraint regexp [expr {[info commands regexp] ne {}}]
+testConstraint socket [expr {[info commands socket] ne {}}]
 
 file delete test1
 
 test pid-1.1 {pid command} regexp {
     regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid]
 } 1
-test pid-1.2 {pid command} regexp {
+test pid-1.2 {pid command} {regexp socket} {
     set f [open {| echo foo | cat >test1} w]
     set pids [pid $f]
     close $f
@@ -34,7 +35,7 @@ test pid-1.2 {pid command} regexp {
        [regexp {^[0-9]+$} [lindex $pids 1]] \
        [expr {[lindex $pids 0] == [lindex $pids 1]}]
 } {2 1 1 0}
-test pid-1.3 {pid command} {
+test pid-1.3 {pid command} socket {
     set f [open test1 w]
     set pids [pid $f]
     close $f
diff --git a/tests/timer.test b/tests/timer.test
index ffa55cc..26ffa0a 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -23,38 +23,38 @@ test timer-1.1 {Tcl_CreateTimerHandler procedure} {
 	after cancel $i
     }
     set x ""
-    foreach i {100 200 1000 50 150} {
+    foreach i {20 40 200 10 30} {
 	after $i lappend x $i
     }
-    after 210
+    after 50
     update
     set x
-} {50 100 150 200}
+} {10 20 30 40}
 
 test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
     foreach i [after info] {
 	after cancel $i
     }
     set x ""
-    foreach i {100 200 300 50 150} {
+    foreach i {20 40 60 10 30} {
 	after $i lappend x $i
     }
-    after cancel lappend x 150
-    after cancel lappend x 50
-    after 210
+    after cancel lappend x 60
+    after cancel lappend x 10
+    after 50
     update
     set x
-} {100 200}
+} {20 30 40}
 
 # No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested
 # above.
 
 test timer-3.1 {TimerHandlerEventProc procedure: event masks} {
     set x start
-    after 100 { set x fired }
+    after 20 { set x fired }
     update idletasks
     set result $x
-    after 200
+    after 40
     update
     lappend result $x
 } {start fired}
@@ -62,42 +62,42 @@ test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
     foreach i [after info] {
 	after cancel $i
     }
-    foreach i {200 600 1000} {
+    foreach i {40 120 200} {
 	after $i lappend x $i
     }
-    after 210
+    after 50
     set result ""
     set x ""
     update
     lappend result $x
-    after 400
+    after 80
     update
     lappend result $x
-    after 400
+    after 80
     update
     lappend result $x
-} {200 {200 600} {200 600 1000}}
+} {40 {40 120} {40 120 200}}
 test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
     foreach i [after info] {
 	after cancel $i
     }
     set x {}
-    after 100 lappend x 100
-    set i [after 300 lappend x 300]
-    after 200 after cancel $i
-    after 400
+    after 20 lappend x 20
+    set i [after 60 lappend x 60]
+    after 40 after cancel $i
+    after 80
     update
     set x
-} 100
+} 20
 test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {
     foreach i [after info] {
 	after cancel $i
     }
     set x {}
-    after 100 lappend x a
-    after 200 lappend x b
-    after 300 lappend x c
-    after 310
+    after 20 lappend x a
+    after 40 lappend x b
+    after 60 lappend x c
+    after 70
     vwait x
     set x
 } {a b c}
@@ -106,8 +106,8 @@ test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't
 	after cancel $i
     }
     set x {}
-    after 100 {lappend x a; after 0 lappend x b}
-    after 100
+    after 20 {lappend x a; after 0 lappend x b}
+    after 20
     vwait x
     set x
 } a
@@ -116,8 +116,8 @@ test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't
 	after cancel $i
     }
     set x {}
-    after 100 {lappend x a; after 100 lappend x b; after 100}
-    after 100
+    after 20 {lappend x a; after 20 lappend x b; after 20}
+    after 20
     vwait x
     set result $x
     vwait x
@@ -181,21 +181,21 @@ test timer-6.3 {Tcl_AfterCmd procedure, basics} jim {
 } {1 {bad argument "gorp": must be cancel, idle, or info}}
 test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
     set x before
-    after 400 {set x after}
-    after 200
+    after 80 {set x after}
+    after 40
     update
     set y $x
-    after 400
+    after 80
     update
     list $y $x
 } {before after}
 test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {
     set x before
-    after 300 {set x after}
-    after 200
+    after 60 {set x after}
+    after 40
     update
     set y $x
-    after 200
+    after 40
     update
     list $y $x
 } {before after}
@@ -213,9 +213,9 @@ test timer-6.9 {Tcl_AfterCmd procedure, cancel option} {
 	after cancel $i
     }
     set x before
-    set y [after 100 set x after]
+    set y [after 20 set x after]
     after cancel $y
-    after 200
+    after 40
     update
     set x
 } {before}
@@ -224,9 +224,9 @@ test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {
 	after cancel $i
     }
     set x before
-    after 100 set x after
+    after 20 set x after
     after cancel set x after
-    after 200
+    after 40
     update
     set x
 } {before}
@@ -235,14 +235,14 @@ test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
 	after cancel $i
     }
     set x before
-    after 100 set x after
-    set id [after 300 set x after]
+    after 20 set x after
+    set id [after 60 set x after]
     after cancel $id
-    after 200
+    after 40
     update
     set y $x
     set x cleared
-    after 200
+    after 40
     update
     list $y $x
 } {after cleared}
@@ -277,7 +277,7 @@ test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, u
 	after cancel $i
     }
     set id [
-	after 100 {
+	after 20 {
 	    set x done
 	    after cancel $id
 	}
@@ -301,8 +301,6 @@ test timer-6.18 {Tcl_AfterCmd procedure, idle option} {
     update idletasks
     list $y $x
 } {before after}
-set event1 [after idle event 1]
-set event2 [after 1000 event 2]
 
 test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} {
     foreach i [after info] {
@@ -410,7 +408,7 @@ test timer-8.1 {AfterProc procedure} {
     set x before
     proc foo {} {
 	set x untouched
-	after 100 {set x after}
+	after 20 {set x after}
 	after 200
 	update
 	return $x
@@ -423,7 +421,7 @@ test timer-8.2 {AfterProc procedure} {
 	set ::x $msg
     }
     set x empty
-    after 100 {error "After error"}
+    after 20 {error "After error"}
     after 200
     set y $x
     update
author	Steve Bennett <steveb@workware.net.au>	2011-12-13 08:09:21 +1000
committer	Steve Bennett <steveb@workware.net.au>	2011-12-13 08:09:21 +1000
commit	746797afafa59846346cee306592540b5b3d11fd (patch)
tree	1a635f67a9f3c35dba07f5abe01f1b3d055ece5d
parent	6ebf6741a8e25b43637348a2a42800c150c3415b (diff)
download	jimtcl-746797afafa59846346cee306592540b5b3d11fd.zip jimtcl-746797afafa59846346cee306592540b5b3d11fd.tar.gz jimtcl-746797afafa59846346cee306592540b5b3d11fd.tar.bz2