tcltest: rework constraint system

Now 'constraint cmd|package' is like 'needs' but sets a constraint
The command to 'needs cmd' and 'constraint cmd' can now take
a subcommand to check.

Add 'constraint|needs eval|expr' to make some constraint checks
simpler.

Signed-off-by: Steve Bennett <steveb@workware.net.au>

35 files changed, 188 insertions, 163 deletions

diff --git a/tcltest.tcl b/tcltest.tcl
index 9478dcd..1f13365 100644
--- a/tcltest.tcl
+++ b/tcltest.tcl
@@ -25,50 +25,120 @@ if {[lsearch $argv "-stoponerror"] >= 0 || [info exists env(stoponerror)]} {
 	incr testinfo(stoponerror)
 }
 
-proc needs {type what {packages {}}} {
+proc needscmdcheck {what {packages {}}} {
+	# Does it exist already?
+	if {[info commands $what] ne ""} {
+		return 1
+	}
+	if {$packages eq ""} {
+		# e.g. exec command is in exec package
+		set packages $what
+	}
+	foreach p $packages {
+		catch {package require $p}
+	}
+	if {[info commands $what] ne ""} {
+		return 1
+	}
+	return 0
+}
+
+# Verifies the constraint/need
+# Returns 1 if the check passes or 0 if not
+proc needcheck {type what args} {
+	# Returns 1 if the check passed or 0 if not
 	if {$type eq "constraint"} {
-		if {![info exists ::tcltest::testConstraints($what)]} {
-			set ::tcltest::testConstraints($what) 0
-		}
-		if {![set ::tcltest::testConstraints($what)]} {
-			skiptest " (constraint $what)"
+		if {[info exists ::tcltest::testConstraints($what)] && $::tcltest::testConstraints($what)} {
+			return 1
 		}
-		return
+		return 0
 	}
 	if {$type eq "cmd"} {
-		# Does it exist already?
-		if {[info commands $what] ne ""} {
-			return
+		lassign $what cmd subcmd
+		if {![needscmdcheck $cmd $args]} {
+			return 0
 		}
-		if {$packages eq ""} {
-			# e.g. exec command is in exec package
-			set packages $what
-		}
-		foreach p $packages {
-			catch {package require $p}
-		}
-		if {[info commands $what] ne ""} {
-			return
+		if {$subcmd ne ""} {
+			if {[testConstraint jim]} {
+				if {$subcmd ni [$cmd -commands]} {
+					return 0
+				}
+			} else {
+				if {[catch {$cmd $subcmd}]} {
+					return 0
+				}
+			}
 		}
-		skiptest " (command $what)"
+		return 1
 	}
 	if {$type eq "package"} {
 		if {[catch {package require $what}]} {
-			skiptest " (package $what)"
+			return 0
+		}
+		return 1
+	}
+	if {$type eq "expr"} {
+		return [uplevel #0 [list expr [lindex $args 0]]]
+	}
+	if {$type eq "eval"} {
+		try {
+			uplevel #0 [lindex $args 0]
+			return 1
+		} on error msg {
+			return 0
 		}
-		return
 	}
 	error "Unknown needs type: $type"
 }
 
-# Simplify setting constraints for whether commands exist
-proc testCmdConstraints {args} {
-	foreach cmd $args {
-		testConstraint $cmd [expr {[info commands $cmd] ne {}}]
+# needs skips all tests in the file if the requirement isn't met
+# constrains sets a constraint to 1 or 0 based on if the requirement is met.
+#
+# needs|constraint cmd {cmd ?subcmd?} ?packages?
+# 
+# Checks that the command 'cmd' (and possibly 'cmd subcmd') exists
+# If necessary, loads the given packages
+# If used as a constraint, the constraint name is $cmd or $cmd-$subcmd
+# 
+# needs constraint name
+# 
+# Checks that the given constraint is set and is met (true)
+# If the constraint hasn't been set, this check fails (returns false)
+# 
+# needs|constraint expr name <expression>
+#
+# Checks that the expression evaluates to true.
+# If used as a constraint, the constraint name is $name
+#
+# needs|constraint eval name <script>
+#
+# Checks that the script evaluated at global scope does not produce an error.
+# If used as a constraint, the constraint name is $name
+#
+# needs|constraint package name ?packages?
+#
+# Checks that the given package is/can be loaded.
+# If necessary, loads the given packages first
+# If used as a constraint, the constraint name is package-$name
+
+proc constraint {type what args} {
+	# XXX constraint constraint doesn't make any sense
+	set ok [needcheck $type $what {*}$args]
+	if {$type eq "package"} {
+		testConstraint package-$what $ok
+	} else {
+		testConstraint [join $what -] $ok
+	}
+}
+
+proc needs {type what args} {
+	if {![needcheck $type $what {*}$args]} {
+		skiptest "  ($type $what)"
 	}
 }
 
 proc skiptest {{msg {}}} {
+	#puts [errorInfo $msg [stacktrace]]
 	puts [format "%16s:   --- skipped$msg" $::testinfo(source)]
 	exit 0
 }
diff --git a/tests/aio.test b/tests/aio.test
index f6852b9..2f16af8 100644
--- a/tests/aio.test
+++ b/tests/aio.test
@@ -1,8 +1,8 @@
 source [file dirname [info script]]/testing.tcl
 
 needs constraint jim
-testCmdConstraints socket
-testConstraint posixaio [expr {$tcl_platform(platform) eq {unix} && !$tcl_platform(bootstrap)}]
+constraint cmd socket
+constraint expr posixaio {$tcl_platform(platform) eq {unix} && !$tcl_platform(bootstrap)}
 
 # Create and open in binary mode for compatibility between Windows and Unix
 set f [open testdata.in wb]
diff --git a/tests/binary.test b/tests/binary.test
index 5c6ca72..2c7f92c 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -16,8 +16,8 @@ needs cmd binary
 if {[testConstraint jim]} {
     needs cmd pack
 }
-testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
-testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+constraint expr bigEndian {$tcl_platform(byteOrder) eq "bigEndian"}
+constraint expr littleEndian {$tcl_platform(byteOrder) eq "littleEndian"}
 testConstraint maxCompatibility 0
 testConstraint notImplemented 0
 
diff --git a/tests/clock.test b/tests/clock.test
index f6c0a23..0ef7bb3 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -1,12 +1,7 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd clock
-
-if {[catch {clock scan 2000 -format %Y}]} {
-    testConstraint clockscan 0
-} else {
-    testConstraint clockscan 1
-}
+constraint cmd {clock scan}
 
 test clock-1.1 {clock usage} -body {
     clock
@@ -59,23 +54,23 @@ test clock-3.13 {clock format tests} -body {
 	clock format 123 odd option count
 } -returnCodes error -result {wrong # args: should be "clock format seconds ?-format string? ?-gmt boolean?"}
 
-test clock-4.1 {clock scan tests} clockscan {
+test clock-4.1 {clock scan tests} clock-scan {
     clock scan {Sun Nov 04 03:02:46 AM 1990} -format {%a %b %d %I:%M:%S %p %Y} -gmt true
 } 657687766
 
-test clock-4.2 {clock scan tests} -constraints clockscan -body {
+test clock-4.2 {clock scan tests} -constraints clock-scan -body {
     clock scan odd number arg count
 } -returnCodes error -result {wrong # args: should be "clock scan str -format format ?-gmt boolean?"}
 
-test clock-4.3 {clock scan tests} -constraints clockscan -body {
+test clock-4.3 {clock scan tests} -constraints clock-scan -body {
     clock scan str -bad option
 } -returnCodes error -result {bad option "-bad": must be -format, or -gmt}
 
-test clock-4.4 {clock scan tests} -constraints clockscan -body {
+test clock-4.4 {clock scan tests} -constraints clock-scan -body {
     clock scan str -gmt true
 } -returnCodes error -result {wrong # args: should be "clock scan str -format format ?-gmt boolean?"}
 
-test clock-4.5 {clock scan tests} -constraints clockscan -body {
+test clock-4.5 {clock scan tests} -constraints clock-scan -body {
     clock scan str -format "%H" -gmt true
 } -returnCodes error -result {Failed to parse time according to format}
 
diff --git a/tests/coverage.test b/tests/coverage.test
index 05d03cf..95933a3 100644
--- a/tests/coverage.test
+++ b/tests/coverage.test
@@ -2,13 +2,11 @@
 
 source [file dirname [info script]]/testing.tcl
 
-testCmdConstraints getref rand namespace
+constraint cmd getref
+constraint cmd rand
+constraint cmd namespace
 
-testConstraint debug-invstr 0
-catch {
-	debug -commands
-	testConstraint debug-invstr 1
-}
+constraint cmd {debug invstr}
 
 test dupobj-1 {duplicate script object} {
 	set y {expr 2}
diff --git a/tests/debug.test b/tests/debug.test
index 253867f..dd12a99 100644
--- a/tests/debug.test
+++ b/tests/debug.test
@@ -1,3 +1,5 @@
+# vim:se syntax=tcl:
+
 source [file dirname [info script]]/testing.tcl
 needs cmd debug
 
diff --git a/tests/dict.test b/tests/dict.test
index 0c2c395..c81ec2d 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1,3 +1,4 @@
+# vim:se syntax=tcl:
 source [file dirname [info script]]/testing.tcl
 
 test dict-1.1 "Basic dict" {
diff --git a/tests/dict2.test b/tests/dict2.test
index 573d17a..f246a97 100644
--- a/tests/dict2.test
+++ b/tests/dict2.test
@@ -8,6 +8,7 @@
 # Copyright (c) 2003-2009 Donal K. Fellows
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# vim:se syntax=tcl:
 
 source [file dirname [info script]]/testing.tcl
 
diff --git a/tests/ensemble.test b/tests/ensemble.test
index 507cd20..3ad60a2 100644
--- a/tests/ensemble.test
+++ b/tests/ensemble.test
@@ -1,3 +1,4 @@
+# vim:se syntax=tcl:
 source [file dirname [info script]]/testing.tcl
 
 needs constraint jim
diff --git a/tests/event.test b/tests/event.test
index b95f76e..453b713 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -12,22 +12,10 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd after eventloop
-testConstraint socket [expr {[info commands socket] ne ""}]
-testConstraint exec [expr {[info commands exec] ne ""}]
-testConstraint signal [expr {[info commands signal] ne ""}]
-catch {[socket -ipv6 stream ::1:5000]} res
-set ipv6 1
-if {[string match "*not supported" $res]} {
-    set ipv6 0
-} else {
-    # Also, if we can't bind an IPv6 socket, don't run IPv6 tests
-    if {[catch {
-        [socket -ipv6 stream.server ::1:5000] close
-    } msg opts]} {
-        set ipv6 0
-    }
-}
-testConstraint ipv6 $ipv6
+constraint cmd socket
+constraint cmd exec
+constraint cmd signal
+constraint eval ipv6 {[socket -ipv6 stream.server ::1:5000] close}
 
 test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} jim {
     catch {rename bgerror {}}
diff --git a/tests/exec.test b/tests/exec.test
index d20cc83..85014a7 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -22,10 +22,10 @@ needs cmd flush
 if {[testConstraint tcl]} {
     testConstraint pipe 1
 } else {
-    testCmdConstraints pipe
+    constraint cmd pipe
 }
 
-testConstraint unix [expr {$tcl_platform(platform) eq {unix}}]
+constraint expr unix {$tcl_platform(platform) eq {unix}}
 
 # Sleep which supports fractions of a second
 if {[info commands sleep] eq {}} {
@@ -447,6 +447,6 @@ file delete sleepx
 
 # Now we probably have a lot of unreaped zombies at this point
 # so reap them to avoid confusing further tests
-wait
+catch {wait}
 
 testreport
diff --git a/tests/exec2.test b/tests/exec2.test
index 7ea1786..9daef58 100644
--- a/tests/exec2.test
+++ b/tests/exec2.test
@@ -5,22 +5,21 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd exec
-testCmdConstraints signal wait alarm after
+constraint cmd signal
+constraint cmd wait
+constraint cmd alarm
+constraint cmd after
 
 # Jim needs [pipe] to implement [open |command]
 if {[testConstraint tcl]} {
 	testConstraint pipe 1
 } else {
-	testCmdConstraints pipe
+	constraint cmd pipe
 }
 
 # Some Windows platforms (e.g. AppVeyor) produce ENOSPC rather than killing
 # the child with SIGPIPE). So turn off this test for that platform
-if {[info exists env(MSYSTEM)] && $env(MSYSTEM) eq "MINGW32"} {
-	testConstraint nomingw32 0
-} else {
-	testConstraint nomingw32 1
-}
+constraint expr nomingw32 {![info exists env(MSYSTEM)] || $env(MSYSTEM) ne "MINGW32"}
 
 set d \"
 set s '
diff --git a/tests/exists.test b/tests/exists.test
index 79f9da0..7531b0c 100644
--- a/tests/exists.test
+++ b/tests/exists.test
@@ -1,7 +1,7 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd exists
-testCmdConstraints lambda
+constraint cmd lambda
 
 test exists-1.1 "Exists var" {
 	set a 1
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 6ed9da7..fd53852 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -18,13 +18,9 @@
 source [file dirname [info script]]/testing.tcl
 
 # Jim Tcl may have no math functions, and may not have specific math functions
-foreach {expr constraint} {sin(0) mathfunc fmod(0,1) expr_fmod hypot(0,1) expr_hypot} {
-    if {[catch {expr $expr} msg]} {
-        testConstraint $constraint 0
-    } else {
-        testConstraint $constraint 1
-    }
-}
+constraint eval mathfunc {expr sin(0)}
+constraint eval expr_fmod {expr fmod(0,1)}
+constraint eval expr_hypot {expr hypot(0,1)}
 
 # First, test all of the integer operators individually.
 
diff --git a/tests/expr-pow.test b/tests/expr-pow.test
index 6389b79..9efcebd 100644
--- a/tests/expr-pow.test
+++ b/tests/expr-pow.test
@@ -15,11 +15,7 @@
 source [file dirname [info script]]/testing.tcl
 
 # Jim Tcl may have no math functions, and may not have specific math functions
-if {[catch {expr pow(1,0)}]} {
-    testConstraint pow 0
-} else {
-    testConstraint pow 1
-}
+constraint eval pow {expr pow(1,0)}
 
 # Tests for exponentiation handling
 test expr-23.1 {CompileExponentialExpr: just exponential expr} {expr 4**2} 16
diff --git a/tests/file.test b/tests/file.test
index e5dd36f..c6fb41e 100644
--- a/tests/file.test
+++ b/tests/file.test
@@ -1,20 +1,15 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd file
-catch {file link} msg
-testConstraint filelink [string match "wrong # args:*" $msg]
-catch {file lstat} msg
-testConstraint filelstat [string match "wrong # args:*" $msg]
-catch {file mtimeus} msg
-testConstraint mtimeus [string match "wrong # args:*" $msg]
-testConstraint unix [expr {$tcl_platform(platform) eq "unix"}]
+constraint cmd {file link}
+constraint cmd {file lstat}
+constraint cmd {file mtimeus}
+constraint expr unix {$tcl_platform(platform) eq "unix"}
 testConstraint normalize 1
 if {[testConstraint jim]} {
-	testConstraint mtimeset [expr {!$tcl_platform(bootstrap)}]
-	testConstraint aiostat [expr {!$tcl_platform(bootstrap)}]
-	if {[catch {file normalize .}]} {
-		testConstraint normalize 0
-	}
+	constraint expr mtimeset {!$tcl_platform(bootstrap)}
+	constraint expr aiostat {!$tcl_platform(bootstrap)}
+	constraint eval normalize {file normalize .}
 } else {
 	testConstraint mtimeset 1
 	testConstraint aiostat 0
@@ -290,11 +285,11 @@ test rename-1.2 {file rename -force, target exists} -body {
 	file delete $name2
 }
 
-test link-1.1 {file link usage} -constraints filelink -body {
+test link-1.1 {file link usage} -constraints file-link -body {
 	file link
 } -returnCodes error -match glob -result {wrong # args: should be "file link*}
 
-test link-1.2 {file hard link} -constraints filelink -body {
+test link-1.2 {file hard link} -constraints file-link -body {
 	set name tmp.[pid]
 	file link $name [info script]
 	file exists $name
@@ -302,7 +297,7 @@ test link-1.2 {file hard link} -constraints filelink -body {
 	file delete $name
 }
 
-test link-1.3 {file hard link} -constraints filelink -body {
+test link-1.3 {file hard link} -constraints file-link -body {
 	set name tmp.[pid]
 	file link -hard $name [info script]
 	file exists $name
@@ -310,7 +305,7 @@ test link-1.3 {file hard link} -constraints filelink -body {
 	file delete $name
 }
 
-test link-1.4 {file sym link} -constraints filelink -body {
+test link-1.4 {file sym link} -constraints file-link -body {
 	set name tmp.[pid]
 	file link -sym $name [info script]
 	list [file exists $name] [file tail [file readlink $name]]
@@ -318,23 +313,23 @@ test link-1.4 {file sym link} -constraints filelink -body {
 	file delete $name
 }
 
-test link-1.5 {file readlink, bad link} -constraints filelink -body {
+test link-1.5 {file readlink, bad link} -constraints file-link -body {
 	file readlink [info script]
 } -returnCodes error -match glob -result {could not read*link "*file.test": *}
 
-test link-1.6 {file link badopt} -constraints filelink -body {
+test link-1.6 {file link badopt} -constraints file-link -body {
 	file link -bad name1 name2
 } -returnCodes error -match glob -result {bad * "-bad": must be *}
 
-test lstat-1.1 {file lstat} -constraints filelstat -body {
+test lstat-1.1 {file lstat} -constraints file-lstat -body {
 	file lstat
 } -returnCodes error -match glob -result {wrong # args: should be "file lstat name *}
 
-test lstat-1.2 {file lstat} -constraints filelstat -body {
+test lstat-1.2 {file lstat} -constraints file-lstat -body {
 	file lstat nonexistent ls
 } -returnCodes error -match glob -result {could not read "nonexistent": *}
 
-test lstat-1.3 {file lstat} -constraints {filelink filelstat} -body {
+test lstat-1.3 {file lstat} -constraints {file-link file-lstat} -body {
 	set name tmp.[pid]
 	file link -sym $name [info script]
 	unset -nocomplain s ls
@@ -413,19 +408,19 @@ test mtime-1.5 {file mtime} -constraints {mtimeset unix} -body {
 	file delete $name
 }
 
-test mtimeus-1.1 {file mtimeus} -constraints mtimeus -body {
+test mtimeus-1.1 {file mtimeus} -constraints file-mtimeus -body {
 	file mtimeus
 } -returnCodes error -result {wrong # args: should be "file mtimeus name ?time?"}
 
-test mtimeus-1.2 {file mtimeus} -constraints mtimeus -body {
+test mtimeus-1.2 {file mtimeus} -constraints file-mtimeus -body {
 	file mtimeus nonexistent
 } -returnCodes error -match glob -result {could not read "nonexistent":*}
 
-test mtimeus-1.3 {file mtimeus} -constraints mtimeus -body {
+test mtimeus-1.3 {file mtimeus} -constraints file-mtimeus -body {
 	file mtimeus [info script] bad
 } -returnCodes error -result {expected integer but got "bad"}
 
-test mtimeus-1.4 {file mtimeus} -constraints mtimeus -body {
+test mtimeus-1.4 {file mtimeus} -constraints file-mtimeus -body {
 	set mtimeus [file mtimeus [info script]]
 	file stat [info script] s
 	if {$mtimeus != $s(mtimeus)} {
diff --git a/tests/filecopy.test b/tests/filecopy.test
index 36382c9..0dc9eb7 100644
--- a/tests/filecopy.test
+++ b/tests/filecopy.test
@@ -5,7 +5,7 @@ needs cmd file
 needs cmd exec
 needs cmd parray tclcompat
 
-testConstraint unix [expr {$tcl_platform(platform) eq "unix"}]
+constraint expr unix {$tcl_platform(platform) eq "unix"}
 
 cd [file dirname [info script]]
 
diff --git a/tests/glob2.test b/tests/glob2.test
index 80fdd12..e6f3fbf 100644
--- a/tests/glob2.test
+++ b/tests/glob2.test
@@ -15,8 +15,8 @@ source [file dirname [info script]]/testing.tcl
 needs cmd file
 needs cmd glob
 
-testConstraint win [expr {$tcl_platform(platform) eq "windows"}]
-testConstraint unix [expr {$tcl_platform(platform) eq "unix"}]
+constraint expr win {$tcl_platform(platform) eq "windows"}
+constraint expr unix {$tcl_platform(platform) eq "unix"}
 testConstraint unixOrPc 1
 
 proc touch filename {catch {close [open $filename w]}}
diff --git a/tests/history.test b/tests/history.test
index 97cf324..70b90bf 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -1,6 +1,6 @@
 source [file dirname [info script]]/testing.tcl
 
-needs cmd history
+needs cmd {history save}
 
 test history-1.1 {history usage} -body {
 	history
diff --git a/tests/jim.test b/tests/jim.test
index e6de376..8151712 100644
--- a/tests/jim.test
+++ b/tests/jim.test
@@ -10,8 +10,9 @@
 source [file dirname [info script]]/testing.tcl
 
 needs constraint jim
-catch {package require regexp}
-testCmdConstraints regexp readdir lambda
+constraint cmd regexp
+constraint cmd readdir
+constraint cmd lambda
 
 ################################################################################
 # SET
diff --git a/tests/lock.test b/tests/lock.test
index fc8a65b..2a93804 100644
--- a/tests/lock.test
+++ b/tests/lock.test
@@ -11,8 +11,7 @@
 source [file dirname [info script]]/testing.tcl
 
 needs constraint jim
-testConstraint aio.lock [expr {"lock" in [stdin -commands]}]
-needs constraint aio.lock
+needs cmd {stdin lock}
 
 set fh [open locktest.file w]
 
diff --git a/tests/lsearch.test b/tests/lsearch.test
index f8aa08d..a222373 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -15,8 +15,7 @@
 
 source [file dirname [info script]]/testing.tcl
 
-catch {package require regexp}
-testConstraint regexp [expr {[info commands regexp] ne {}}]
+constraint cmd regexp
 
 set x {abcd bbcd 123 234 345}
 test lsearch-1.1 {lsearch command} {
diff --git a/tests/nsensemble.test b/tests/nsensemble.test
index 9306167..add2b39 100644
--- a/tests/nsensemble.test
+++ b/tests/nsensemble.test
@@ -3,7 +3,7 @@ source [file dirname [info script]]/testing.tcl
 needs constraint jim
 needs cmd ensemble
 needs cmd namespace
-testConstraint package-ensemble [expr {"ensemble" in [package list]}]
+constraint package ensemble 
 
 # Let's create some procs for our ensemble
 namespace eval foo {
diff --git a/tests/pid.test b/tests/pid.test
index 56ffcf8..a1773fe 100644
--- a/tests/pid.test
+++ b/tests/pid.test
@@ -17,19 +17,18 @@ source [file dirname [info script]]/testing.tcl
 
 needs cmd pid posix
 needs cmd exec
-catch {package require regexp}
-testConstraint regexp [expr {[info commands regexp] ne {}}]
-testConstraint pipe [expr {[info commands pipe] ne {}}]
-testConstraint getpid [expr {[catch pid] == 0}]
+constraint cmd regexp
+constraint cmd pipe
+constraint cmd pid
 # This is a proxy for tcl || tclcompat
-testConstraint pidchan [expr {[info commands fconfigure] ne {}}]
+constraint cmd fconfigure
 
 file delete test1
 
-test pid-1.1 {pid command} {regexp getpid} {
+test pid-1.1 {pid command} {regexp pid} {
     regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid]
 } 1
-test pid-1.2 {pid command} {regexp pipe pidchan} {
+test pid-1.2 {pid command} {regexp pipe fconfigure} {
     set f [open {| echo foo | cat >test1} w]
     set pids [pid $f]
     close $f
@@ -38,16 +37,16 @@ test pid-1.2 {pid command} {regexp pipe pidchan} {
        [regexp {^[0-9]+$} [lindex $pids 1]] \
        [expr {[lindex $pids 0] == [lindex $pids 1]}]
 } {2 1 1 0}
-test pid-1.3 {pid command} {pipe pidchan} {
+test pid-1.3 {pid command} {pipe fconfigure} {
     set f [open test1 w]
     set pids [pid $f]
     close $f
     set pids
 } {}
-test pid-1.4 {pid command} pidchan {
+test pid-1.4 {pid command} fconfigure {
     list [catch {pid a b} msg] $msg
 } {1 {wrong # args: should be "pid ?channelId?"}}
-test pid-1.5 {pid command} pidchan {
+test pid-1.5 {pid command} fconfigure {
     list [catch {pid gorp} msg] $msg
 } {1 {can not find channel named "gorp"}}
 
diff --git a/tests/posix.test b/tests/posix.test
index f34ced7..bb9d132 100644
--- a/tests/posix.test
+++ b/tests/posix.test
@@ -1,7 +1,10 @@
 source [file dirname [info script]]/testing.tcl
 
 needs constraint jim
-testCmdConstraints os.getids os.gethostname os.uptime os.fork
+constraint cmd os.getids
+constraint cmd os.gethostname
+constraint cmd os.uptime
+constraint cmd os.fork
 
 test posix-1.1 {os.getids usage} -constraints os.getids -body {
 	os.getids blah
diff --git a/tests/prefix.test b/tests/prefix.test
index e81d429..5a5374d 100644
--- a/tests/prefix.test
+++ b/tests/prefix.test
@@ -15,7 +15,7 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd tcl::prefix tclprefix
-testConstraint namespace [expr {[info commands namespace] ne ""}]
+constraint cmd namespace
 
 test string-26.1 {tcl::prefix, too few args} -body {
     tcl::prefix match a
diff --git a/tests/regcount.test b/tests/regcount.test
index dd8119f..229d9be 100644
--- a/tests/regcount.test
+++ b/tests/regcount.test
@@ -1,8 +1,7 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd regexp
-testConstraint regexp_are [expr {[regexp {\d} 1]}]
-needs constraint regexp_are
+needs expr regexp_are {[regexp {\d} 1]}
 
 # Test regexp counted repetitions
 
diff --git a/tests/regexp.test b/tests/regexp.test
index 9793038..a7c8a4a 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -16,7 +16,7 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd regexp
-testConstraint regexp_are [regexp {\d} 1]
+constraint expr regexp_are {[regexp {\d} 1]}
 
 catch {unset foo}
 test regexp-1.1 {basic regexp operation} {
diff --git a/tests/regexp2.test b/tests/regexp2.test
index 156454f..571c981 100644
--- a/tests/regexp2.test
+++ b/tests/regexp2.test
@@ -16,8 +16,7 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd regexp
-testConstraint regexp_are [regexp {\d} 1]
-needs constraint regexp_are
+needs expr regexp_are {[regexp {\d} 1]}
 
 # Procedure to evaluate a script within a proc, to test compilation
 # functionality
diff --git a/tests/regmin.test b/tests/regmin.test
index ed4f1cd..ec0a2c4 100644
--- a/tests/regmin.test
+++ b/tests/regmin.test
@@ -1,8 +1,7 @@
 source [file dirname [info script]]/testing.tcl
 
 needs cmd regexp
-testConstraint regexp_are [regexp {\d} 1]
-needs constraint regexp_are
+needs expr regexp_are {[regexp {\d} 1]}
 
 test regexpmin-1.1 {Minimal +} {
     regexp -inline {x(a|b|c)+?c} xabcabc
diff --git a/tests/runall.tcl b/tests/runall.tcl
index 5c9aa8b..55d6df7 100644
--- a/tests/runall.tcl
+++ b/tests/runall.tcl
@@ -26,7 +26,7 @@ if {[info commands interp] eq ""} {
 	foreach script [lsort [glob $testdir/*.test]] {
 		set ::argv0 $script
 
-		if {[file tail $script] in {signal.test exec2.test}} {
+		if {[file tail $script] in {signal.test event.test exec2.test}} {
 			# special case, can't run these in a child interpeter
 			catch -exit {
 				source $script
diff --git a/tests/signal.test b/tests/signal.test
index 0c3479d..caed950 100644
--- a/tests/signal.test
+++ b/tests/signal.test
@@ -2,7 +2,7 @@ source [file dirname [info script]]/testing.tcl
 
 needs cmd signal
 needs cmd pid
-testConstraint try [expr {[info commands try] ne ""}]
+constraint cmd try
 
 test signal-1.1 "catch/throw" {
 	signal handle TERM
diff --git a/tests/socket.test b/tests/socket.test
index 1eb98b4..c0361a7 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -4,19 +4,7 @@ needs constraint jim
 needs cmd socket
 needs cmd os.fork
 
-catch {[socket -ipv6 stream {[::1]:5000}]} res
-set ipv6 1
-if {[string match "*not supported" $res]} {
-    set ipv6 0
-} else {
-    # Also, if we can't bind an IPv6 socket, don't run IPv6 tests
-    if {[catch {
-        [socket -ipv6 stream.server {[::1]:5000}] close
-    } msg opts]} {
-        set ipv6 0
-    }
-}
-testConstraint ipv6 $ipv6
+constraint eval ipv6 {[socket -ipv6 stream.server ::1:5000] close}
 
 # Given an IPv4 or IPv6 server socket, return an address
 # that a client can use to connect to the socket.
diff --git a/tests/tty.test b/tests/tty.test
index 6f2cb4b..5199e6a 100644
--- a/tests/tty.test
+++ b/tests/tty.test
@@ -1,10 +1,7 @@
 source [file dirname [info script]]/testing.tcl
 
-set havetty 0
-catch {
-    set havetty [expr {"tty" in [stdout -commands]}]
-}
-if {!$havetty || ![stdout isatty]} {
+needs cmd {stdout tty}
+if {![stdout isatty]} {
     skiptest "  (aio tty)"
 }
 
diff --git a/tests/util.test b/tests/util.test
index 6b54425..3902b5c 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -11,8 +11,8 @@ source [file dirname [info script]]/testing.tcl
 
 needs cmd binary
 testConstraint controversialNaN 1
-testConstraint testdstring [llength [info commands testdstring]]
-testConstraint testconcatobj [llength [info commands testconcatobj]]
+constraint cmd testdstring
+constraint cmd testconcatobj
 
 # Big test for correct ordering of data in [expr]