From 192056900583884bc1f07f371df6478d856ada3b Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Sat, 30 Oct 2010 15:21:21 +1000
Subject: Overhaul unit test framework

Much closer to tcltest now, including constraints.
Try to get all appropriate tests running under both Jim and Tcl.

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 Makefile.in            |   3 +-
 tests/Makefile         |   3 -
 tests/alias.test       |   6 +-
 tests/array.test       |   2 +-
 tests/case.test        |   6 +-
 tests/concat.test      |   4 +-
 tests/dict.test        |  10 ++-
 tests/error.test       |   6 +-
 tests/event.test       |  15 ++--
 tests/exec.test        |  11 +--
 tests/exec2.test       |   7 +-
 tests/expand.test      |   6 +-
 tests/expr-new.test    |   6 +-
 tests/expr-old.test    |   4 +-
 tests/expr.test        |  12 ++--
 tests/filecopy.test    |   7 +-
 tests/filedir.test     |   7 +-
 tests/filejoin.test    |   9 ++-
 tests/for.test         |   2 +-
 tests/format.test      |  38 +++++------
 tests/infoframe.test   |   4 +-
 tests/jim.test         |  26 ++++---
 tests/list.test        |   2 +-
 tests/lsearch.test     |  22 +++---
 tests/lsort.test       |  16 ++---
 tests/lsortcmd.test    |   4 +-
 tests/misc.test        |  14 ++--
 tests/perf.test        |   6 ++
 tests/pid.test         |   6 +-
 tests/proc-new.test    |   6 +-
 tests/proc.test        |   4 +-
 tests/regcount.test    |   6 +-
 tests/regexp.test      |  29 ++++----
 tests/regexp2.test     |  12 ++--
 tests/rename.test      |   2 +-
 tests/return.test      |   4 +-
 tests/scan.test        |  60 ++++++++--------
 tests/stacktrace.test  |   4 +-
 tests/string.test      |  50 +++++++-------
 tests/stringmatch.test |  56 +++++++--------
 tests/subst.test       |   2 +-
 tests/tailcall.test    |   6 +-
 tests/testing.tcl      | 182 ++++++++++++++++++++++++++++++-------------------
 tests/timer.test       |   8 +--
 tests/tree.test        |   8 +--
 tests/try.test         |  11 ++-
 tests/uplevel.test     |   2 +-
 tests/upvar.test       |   8 +--
 tests/utf8.test        |   7 +-
 tests/utftcl.test      |   6 +-
 tests/while.test       |   2 +-
 51 files changed, 392 insertions(+), 347 deletions(-)

diff --git a/Makefile.in b/Makefile.in
index 1b077df..22a03ee 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -75,8 +75,7 @@ install: all docs $(EXTENSION_TCL)
 	install Tcl.html $(DESTDIR)/doc/jim
 
 test:
-	$(MAKE) -C tests
-
+	$(MAKE) jimsh=$(shell pwd)/jimsh -C tests
 
 $(OBJS) $(EXTENSION_OBJS): Makefile
 
diff --git a/tests/Makefile b/tests/Makefile
index 02c6c1e..caca931 100644
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -5,8 +5,5 @@ export JIMLIB := ..:.
 test:
 	@set -e; for i in *.test; do $(jimsh) $$i; done
 
-../jimsh: ../*.c
-	make -C .. all
-
 clean:
 	rm -f gorp.file2 cat gorp.file sleep exit wc sh echo test1
diff --git a/tests/alias.test b/tests/alias.test
index 94aa4f1..e0e2775 100644
--- a/tests/alias.test
+++ b/tests/alias.test
@@ -1,4 +1,6 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+
+needs constraint jim
 
 test alias-1.1 "One word alias" {
 	set x 2
@@ -121,3 +123,5 @@ test local-1.9 "local on existing proc" {
 	}
 	list [info procs a] $result 
 } {{} {2 1}}
+
+testreport
diff --git a/tests/array.test b/tests/array.test
index de9283c..efc875c 100644
--- a/tests/array.test
+++ b/tests/array.test
@@ -1,4 +1,4 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 array set a {
 	1 one
diff --git a/tests/case.test b/tests/case.test
index 74f7405..ad35756 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -1,4 +1,6 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+
+needs cmd case {tclcompat}
 
 catch {unset result}
 test case-1.1 "Simple case" {
@@ -80,3 +82,5 @@ test case-2.6 "break from case" {
 	list [catch {do_case 6} msg] $msg
 } {1 {invoked "break" outside of a loop}}
 }
+
+testreport
diff --git a/tests/concat.test b/tests/concat.test
index 7f961a8..79aec87 100644
--- a/tests/concat.test
+++ b/tests/concat.test
@@ -1,4 +1,4 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 test concat-1.1 {simple concatenation} {
     concat a b c d e f g
@@ -62,3 +62,5 @@ test concat-6.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
     # Check for Bug #227512.  If this violates C isspace, then it returns \xc3.
     concat \xe0
 } \xe0
+
+testreport
diff --git a/tests/dict.test b/tests/dict.test
index abccdb3..f68db1e 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1,6 +1,4 @@
-package require testing
-
-section "basic dict"
+source [file dirname [info script]]/testing.tcl
 
 test dict-1.1 "Basic dict" {
 	set d [dict create]
@@ -13,7 +11,7 @@ test dict-1.1 "Basic dict" {
 
 catch {unset d}
 
-test dict-2.1 "Dict via reference" {
+test dict-2.1 "Dict via reference" references {
 	set d [dict create]
 	dict set d fruit apple
 	dict set d car holden
@@ -23,7 +21,7 @@ test dict-2.1 "Dict via reference" {
 	dict get [getref $dref] car
 } {holden}
 
-test dict-2.2 "Modify dict via reference" {
+test dict-2.2 "Modify dict via reference" references {
 	# Get the value out of the refernence
 	set d [getref $dref]
 	# Modify it
@@ -34,7 +32,7 @@ test dict-2.2 "Modify dict via reference" {
 	dict get [getref $dref] car
 } {toyota}
 
-test dict-2.3 "Modify dict via reference - one line" {
+test dict-2.3 "Modify dict via reference - one line" references {
 	# Get the value out of the refernence
 	set d [getref $dref]
 	setref $dref [dict set d car toyota]
diff --git a/tests/error.test b/tests/error.test
index 3a08a6e..54d1731 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -1,5 +1,5 @@
-package require testing
-
+source [file dirname [info script]]/testing.tcl
+needs constraint jim
 proc a {} {
 	error "error thrown from a"
 }
@@ -51,3 +51,5 @@ test error-1.2 "Modify stacktrace" {
 test error-2.1 "Exit from package" {
 	list [catch -exit {package require exitpackage} msg] $msg
 } {6 {Can't load package exitpackage}}
+
+testreport
diff --git a/tests/event.test b/tests/event.test
index 725d63b..da4af79 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -9,10 +9,12 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-source testing.tcl
-package-or-skip eventloop
+source [file dirname [info script]]/testing.tcl
 
-test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
+needs cmd after eventloop
+testConstraint socket [expr {[info commands socket] ne ""}]
+
+test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} jim {
     catch {rename bgerror {}}
     proc bgerror msg {
 	lappend ::x $msg
@@ -80,7 +82,7 @@ test event-11.1 {Tcl_VwaitCmd procedure} {
 test event-11.2 {Tcl_VwaitCmd procedure} {
     list [catch {vwait a b} msg] $msg
 } {1 {wrong # args: should be "vwait name"}}
-test event-11.3 {Tcl_VwaitCmd procedure} {
+test event-11.3 {Tcl_VwaitCmd procedure} jim {
     catch {unset x}
     set x 1
     list [catch {vwait x(1)} msg] $msg
@@ -105,8 +107,7 @@ foreach i [after info] {
     after cancel $i
 }
 
-if {[info commands socket] ne ""} {
-test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {
+test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {jim socket} {
     set f1 [open test1 w]
     proc accept {s args} {
 	puts $s foobar
@@ -129,7 +130,7 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {
     file delete test1 test2
     list $x $y $z
 } {3 3 done}
-}
+
 test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
     file delete test1 test2
     set f1 [open test1 w]
diff --git a/tests/exec.test b/tests/exec.test
index a43f065..8b9a743 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -13,8 +13,9 @@
 #
 # RCS: @(#) $Id: exec.test,v 1.8.2.1 2001/10/17 19:29:25 das Exp $
 
-source testing.tcl
-package-or-skip exec
+source [file dirname [info script]]/testing.tcl
+
+needs cmd exec
 
 set f [open echo w]
 puts $f {
@@ -304,16 +305,16 @@ test exec-9.2 {commands returning errors} {
 test exec-9.3 {commands returning errors} {
     list [catch {exec sleep 1 | false | sleep 1} msg]
 } {1}
-test exec-9.4 {commands returning errors} {
+test exec-9.4 {commands returning errors} jim {
     list [catch {exec false | echo "foo bar"} msg] $msg
 } {1 {foo bar}}
 test exec-9.5 {commands returning errors} {
     list [catch {exec gorp456 | echo a b c} msg]
 } {1}
-test exec-9.6 {commands returning errors} {
+test exec-9.6 {commands returning errors} jim {
     list [catch {exec sh -c "echo error msg 1>&2"} msg] $msg
 } {0 {error msg}}
-test exec-9.7 {commands returning errors} {
+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
diff --git a/tests/exec2.test b/tests/exec2.test
index fcf572f..a15e409 100644
--- a/tests/exec2.test
+++ b/tests/exec2.test
@@ -2,8 +2,9 @@
 # of exec where sh -c must be used and thus we must take extra care
 # in quoting arguments to exec.
 
-source testing.tcl
-package-or-skip exec
+source [file dirname [info script]]/testing.tcl
+
+needs cmd exec
 
 set d \"
 set s '
@@ -38,3 +39,5 @@ test exec2-2.4 "Remove all env var" {
 	unset -nocomplain env
 	exec printenv | sed -n -e /^testenv2=/p
 } {}
+
+testreport
diff --git a/tests/expand.test b/tests/expand.test
index 1527cd9..2c7023a 100644
--- a/tests/expand.test
+++ b/tests/expand.test
@@ -1,6 +1,4 @@
-source testing.tcl
-
-section "Expand Testing"
+source [file dirname [info script]]/testing.tcl
 
 test expand-1.1 "Basic tests" {
 	set a {1 2 3}
@@ -8,7 +6,7 @@ test expand-1.1 "Basic tests" {
 	lappend a {*}$b
 } {1 2 3 4 5 6}
 
-test expand-1.2 "Basic tests" {
+test expand-1.2 "Basic tests" jim {
 	set a {1 2 3}
 	set b {4 5 6}
 	lappend a {expand}$b
diff --git a/tests/expr-new.test b/tests/expr-new.test
index c6da9fc..1130eb1 100644
--- a/tests/expr-new.test
+++ b/tests/expr-new.test
@@ -12,7 +12,7 @@
 #
 # RCS: @(#) $Id: expr.test,v 1.9 2000/04/10 17:18:59 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 # procedures used below
 
@@ -271,11 +271,11 @@ test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
 # architectures because LONG_MIN is different
 
 if {0x80000000 > 0} {
-    test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
+    test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN (64bit)} jim {
 	expr {1<<63}
     } -9223372036854775808
 } else {
-    test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
+    test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN (32bit)} jim {
 	expr {1<<31}
     } -2147483648
 }
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 87d156b..2aacf77 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -15,7 +15,7 @@
 #
 # RCS: @(#) $Id: expr-old.test,v 1.8.2.1 2002/04/18 13:10:27 msofer Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 # First, test all of the integer operators individually.
 
@@ -82,7 +82,7 @@ test expr-old-1.53 {integer operators} {
 # automatic conversion to integers where needed.
 
 test expr-old-2.1 {floating-point operators} {expr -4.2} -4.2
-test expr-old-2.2 {floating-point operators} {expr -(1.1+4.2)} -5.3
+test expr-old-2.2 {floating-point operators} jim {expr -(1.1+4.2)} -5.3
 test expr-old-2.3 {floating-point operators} {expr +5.7} 5.7
 test expr-old-2.4 {floating-point operators} {expr +--+-62.0} -62.0
 test expr-old-2.5 {floating-point operators} {expr !2.1} 0
diff --git a/tests/expr.test b/tests/expr.test
index a7ba78c..682af89 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -1,6 +1,4 @@
-source testing.tcl
-
-section "String comparison"
+source [file dirname [info script]]/testing.tcl
 
 test expr-1.1 "Compare strings lt" {
 	expr {"V000500" < "V000405"}
@@ -68,19 +66,19 @@ test expr-1.13 "Short circuit evaluation" {
 	list $a $c
 } {100 1}
 
-test expr-1.14 "Rotate left" {
+test expr-1.14 "Rotate left" jim {
 	expr {1 <<< 5}
 } {32}
 
-test expr-1.15 "Rotate left" {
+test expr-1.15 "Rotate left" jim {
 	expr {1 <<< 65}
 } {2}
 
-test expr-1.16 "Rotate right" {
+test expr-1.16 "Rotate right" jim {
 	expr {1 >>> 48}
 } {65536}
 
-test expr-1.17 "Rotate left" {
+test expr-1.17 "Rotate left" jim {
 	expr {1 >>> 63}
 } {2}
 
diff --git a/tests/filecopy.test b/tests/filecopy.test
index 7dab00f..dc00041 100644
--- a/tests/filecopy.test
+++ b/tests/filecopy.test
@@ -1,6 +1,7 @@
-source testing.tcl
-package-or-skip file
-package-or-skip bio
+source [file dirname [info script]]/testing.tcl
+
+needs cmd file
+needs cmd bio
 
 file mkdir tempdir
 
diff --git a/tests/filedir.test b/tests/filedir.test
index 95dbd0c..4dd78ca 100644
--- a/tests/filedir.test
+++ b/tests/filedir.test
@@ -1,6 +1,7 @@
-source testing.tcl
-package-or-skip file
-package-or-skip exec
+source [file dirname [info script]]/testing.tcl
+
+needs cmd file
+needs cmd exec
 
 catch {
 	exec rm -rf tmp
diff --git a/tests/filejoin.test b/tests/filejoin.test
index c6d2572..0cf1e03 100644
--- a/tests/filejoin.test
+++ b/tests/filejoin.test
@@ -1,5 +1,6 @@
-source testing.tcl
-package-or-skip file
+source [file dirname [info script]]/testing.tcl
+
+needs cmd file
 
 test join-1.1 "One name" {
 	file join abc
@@ -57,7 +58,9 @@ test join-2.2 "File is empty string" {
 	file join abc ""
 } {abc}
 
-test join-2.3 "Path too long" {
+test join-2.3 "Path too long" jim {
 	set components [string repeat {abcdefghi } 500]
 	list [catch [concat file join $components] msg] $msg
 } {1 {Path too long}}
+
+testreport
diff --git a/tests/for.test b/tests/for.test
index d3a136e..d12385a 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -14,7 +14,7 @@
 #
 # RCS: @(#) $Id: for-old.test,v 1.5 2000/04/10 17:18:59 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 # Check "for" and its use of continue and break.
 
diff --git a/tests/format.test b/tests/format.test
index 7926379..475be48 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -12,7 +12,9 @@
 #
 # RCS: @(#) $Id: format.test,v 1.8 2000/04/10 17:18:59 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+
+needs cmd format
 
 # The following code is needed because some versions of SCO Unix have
 # a round-off error in sprintf which would cause some of the tests to
@@ -81,14 +83,12 @@ test format-2.4 {string formatting} {
 test format-2.5 {string formatting, embedded nulls} {
     format "%10s" abc\0def
 } "   abc\0def"
-ifutf8 {
-    test format-2.6 {string formatting, international chars} {
-        format "%10s" abc\ufeffdef
-    } "   abc\ufeffdef"
-    test format-2.6 {string formatting, international chars} {
-        format "%.5s" abc\ufeffdef
-    } "abc\ufeffd"
-}
+test format-2.6 {string formatting, international chars} utf8 {
+    format "%10s" abc\ufeffdef
+} "   abc\ufeffdef"
+test format-2.6 {string formatting, international chars} utf8 {
+    format "%.5s" abc\ufeffdef
+} "abc\ufeffd"
 test format-2.7 {string formatting, international chars} {
     format "foo\ufeffbar%s" baz
 } "foo\ufeffbarbaz"
@@ -119,16 +119,12 @@ test format-2.8 {string formatting, width and precision} {
 test format-2.8 {string formatting, width and precision} {
     format "a%5.7sa" foobarbaz
 } "afoobarba"
-
-ifutf8 {
-    test format-3.1 {Tcl_FormatObjCmd: character formatting} {
-        format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65
-    } "|A|A|A|A|A     |     A|  A|A   |"
-    test format-3.2 {Tcl_FormatObjCmd: international character formatting} {
-        format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xa2 0x4e4e 0x25a 0xc3 0xff08 0 3 0x6575 -4 0x4e4f
-    } "|\ua2|\u4e4e|\u25a|\uc3|\uff08     |     \0|  \u6575|\u4e4f   |"
-}
-
+test format-3.1 {Tcl_FormatObjCmd: character formatting} utf8 {
+    format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 65 65 65 65 65 65 3 65 -4 65
+} "|A|A|A|A|A     |     A|  A|A   |"
+test format-3.2 {Tcl_FormatObjCmd: international character formatting} utf8 {
+    format "|%c|%0c|%-1c|%1c|%-6c|%6c|%*c|%*c|" 0xa2 0x4e4e 0x25a 0xc3 0xff08 0 3 0x6575 -4 0x4e4f
+} "|\ua2|\u4e4e|\u25a|\uc3|\uff08     |     \0|  \u6575|\u4e4f   |"
 test format-4.1 {e and f formats} {
     format "%e %e %e %e" 34.2e12 68.514 -.125 -16000. .000053
 } {3.420000e+13 6.851400e+01 -1.250000e-01 -1.600000e+04}
@@ -279,7 +275,7 @@ test format-7.3 {various syntax features} {
 test format-8.1 {error conditions} {
     catch format
 } 1
-test format-8.2 {error conditions} {
+test format-8.2 {error conditions} jim {
     catch format msg
     set msg
 } {wrong # args: should be "format formatString ?arg arg ...?"}
@@ -327,7 +323,7 @@ test format-8.14 {error conditions} {
 test format-8.15 {error conditions} {
     catch {format %f 2.1z}
 } 1
-test format-8.16 {error conditions} {
+test format-8.16 {error conditions} jim {
     catch {format %f 2.1z} msg
     set msg
 } {expected number but got "2.1z"}
diff --git a/tests/infoframe.test b/tests/infoframe.test
index 1a637ea..f1619f5 100644
--- a/tests/infoframe.test
+++ b/tests/infoframe.test
@@ -1,5 +1,5 @@
-source testing.tcl
-
+source [file dirname [info script]]/testing.tcl
+needs constraint jim
 proc a {n} {
 	if {$n eq "trace"} {
 		stacktrace
diff --git a/tests/jim.test b/tests/jim.test
index 1fcead3..1d477e2 100644
--- a/tests/jim.test
+++ b/tests/jim.test
@@ -7,13 +7,11 @@
 #
 # Sometimes tests are modified to reflect different error messages.
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
+needs constraint jim
 catch {package require regexp}
-
-if {[info commands regexp] eq ""} {
-    proc regexp {pat str} {expr {$pat eq "^a*b$" && $str eq "aaaab"}}
-}
+testConstraint regexp [expr {[info commands regexp] ne {}}]
 
 ################################################################################
 # SET
@@ -2452,7 +2450,7 @@ test switch-3.1 {-exact vs. -glob vs. -regexp} {
 	default	{concat none}
     }
 } exact
-test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} {
+test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} regexp {
 	rename regexp regexp.none
     set rc [catch {
         switch -regexp aaaab {
@@ -2466,7 +2464,7 @@ test switch-3.2 {-exact vs. -glob vs. -regexp (no [regexp] cmd)} {
 	set rc
 } 1
 
-test switch-3.3 {-exact vs. -glob vs. -regexp (with [regexp] cmd)} {
+test switch-3.3 {-exact vs. -glob vs. -regexp (with [regexp] cmd)} regexp {
     switch -regexp aaaab {
 	^a*b$	{concat regexp}
 	*b	    {concat glob}
@@ -2516,13 +2514,13 @@ test switch-4.5 {error in default command} {
 	    default {error switch2}} msg] $msg
 } {1 switch2}
 
-#~ test switch-5.1 {errors in -regexp matching} {
-    #~ list [catch {switch -regexp aaaab {
-	#~ *b	{concat glob}
-	#~ aaaab	{concat exact}
-	#~ default	{concat none}
-    #~ }} msg] $msg
-#~ } {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
+test switch-5.1 {errors in -regexp matching} regexp {
+    list [catch {switch -regexp aaaab {
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }} msg] $msg
+} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
 
 test switch-6.1 {backslashes in patterns} {
     switch -exact {\a\$\.\[} {
diff --git a/tests/list.test b/tests/list.test
index b82a741..3889018 100644
--- a/tests/list.test
+++ b/tests/list.test
@@ -13,7 +13,7 @@
 #
 # RCS: @(#) $Id: list.test,v 1.5 2000/04/10 17:19:01 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 # First, a bunch of individual tests
 
diff --git a/tests/lsearch.test b/tests/lsearch.test
index d1453b6..53642c9 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -13,7 +13,7 @@
 #
 # RCS: @(#) $Id: lsearch.test,v 1.5 2000/04/10 17:19:01 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 set x {abcd bbcd 123 234 345}
 test lsearch-1.1 {lsearch command} {
@@ -136,43 +136,43 @@ test lsearch-5.11 {lsearch -inline, no match} {
     lsearch -glob -inline {a1 a2 b1 b2 a3 b3} C*
 } {}
 
-test lsearch-6.1 {lsearch -bool, found} {
+test lsearch-6.1 {lsearch -bool, found} jim {
     lsearch -bool {a1 a2 b1 b2 a3 b3} b1
 } {1}
 
-test lsearch-6.2 {lsearch -bool, not found} {
+test lsearch-6.2 {lsearch -bool, not found} jim {
     lsearch -bool {a1 a2 b1 b2 a3 b3} c1
 } {0}
 
-test lsearch-6.3 {lsearch -not -bool, found} {
+test lsearch-6.3 {lsearch -not -bool, found} jim {
     lsearch -not -bool {a1 a2 b1 b2 a3 b3} b1
 } {0}
 
-test lsearch-6.4 {lsearch -not -bool, not found} {
+test lsearch-6.4 {lsearch -not -bool, not found} jim {
     lsearch -not -bool {a1 a2 b1 b2 a3 b3} c1
 } {1}
 
-test lsearch-6.5 {lsearch -bool -all} {
+test lsearch-6.5 {lsearch -bool -all} jim {
     lsearch -bool -glob -all {a1 a2 b1 b2 a3 b3} a*
 } {1 1 0 0 1 0}
 
-test lsearch-6.6 {lsearch -bool -all no match} {
+test lsearch-6.6 {lsearch -bool -all no match} jim {
     lsearch -bool -glob -all {a1 a2 b1 b2 a3 b3} B*
 } {0 0 0 0 0 0}
 
-test lsearch-6.7 {lsearch -bool -all -nocase} {
+test lsearch-6.7 {lsearch -bool -all -nocase} jim {
     lsearch -bool -glob -all -nocase {a1 a2 b1 b2 a3 b3} B*
 } {0 0 1 1 0 1}
 
-test lsearch-6.8 {lsearch -not -bool -all} {
+test lsearch-6.8 {lsearch -not -bool -all} jim {
     lsearch -not -bool -glob -all {a1 a2 b1 b2 a3 b3} a*
 } {0 0 1 1 0 1}
 
-test lsearch-6.9 {lsearch -not -bool -all no match} {
+test lsearch-6.9 {lsearch -not -bool -all no match} jim {
     lsearch -not -bool -glob -all {a1 a2 b1 b2 a3 b3} B*
 } {1 1 1 1 1 1}
 
-test lsearch-6.10 {lsearch -not -bool -all -nocase} {
+test lsearch-6.10 {lsearch -not -bool -all -nocase} jim {
     lsearch -not -bool -glob -all -nocase {a1 a2 b1 b2 a3 b3} B*
 } {1 1 0 0 1 0}
 
diff --git a/tests/lsort.test b/tests/lsort.test
index fb04644..1a61fdb 100644
--- a/tests/lsort.test
+++ b/tests/lsort.test
@@ -10,12 +10,12 @@
 #
 # RCS: @(#) $Id: lsort.test,v 1.12.2.2 2001/10/08 15:50:24 dkf Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
-test lsort-1.1 {Tcl_LsortObjCmd procedure} {
+test lsort-1.1 {Tcl_LsortObjCmd procedure} jim {
     list [catch {lsort} msg] $msg
 } {1 {wrong # args: should be "lsort ?options? list"}}
-test lsort-1.2 {Tcl_LsortObjCmd procedure} {
+test lsort-1.2 {Tcl_LsortObjCmd procedure} jim {
     list [catch {lsort -foo {1 3 2 5}} msg] $msg
 } {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, or -nocase}}
 test lsort-1.3 {Tcl_LsortObjCmd procedure, default options} {
@@ -121,10 +121,10 @@ test lsort-3.1 {SortCompare procedure, skip comparisons after error} {
     list [catch {lsort -integer -command cmp {48 6 28 190 16 2 3 6 1}} msg] \
 	    $msg $x
 } {1 {error #1} 1}
-test lsort-3.3 {SortCompare procedure, -index option} {
+test lsort-3.3 {SortCompare procedure, -index option} jim {
     list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg
 } {1 {list index out of range}}
-test lsort-3.5 {SortCompare procedure, -index option} {
+test lsort-3.5 {SortCompare procedure, -index option} jim {
     list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg
 } {1 {list index out of range}}
 test lsort-3.6 {SortCompare procedure, -index option} {
@@ -154,7 +154,7 @@ test lsort-3.16 {SortCompare procedure, -command option, long command} {
     }
     lsort -command {cmp {this argument is very very long in order to make the dstring overflow its statically allocated space}} {{this first element is also long in order to help expand the dstring} {the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring}}
 } {{the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring} {this first element is also long in order to help expand the dstring}}
-test lsort-3.17 {SortCompare procedure, -command option, non-integer result} {
+test lsort-3.17 {SortCompare procedure, -command option, non-integer result} jim {
     proc cmp {a b} {
 	return foow
     }
@@ -170,8 +170,7 @@ test lsort-3.19 {SortCompare procedure, -decreasing option} {
     lsort -decreasing -integer {35 21 0x20 30 023 100 8}
 } {100 35 0x20 30 21 023 8}
 
-ifutf8 {
-test lsort-4.26 {DefaultCompare procedure, signed characters} {
+test lsort-4.26 {DefaultCompare procedure, signed characters} utf8 {
     set l [lsort [list "abc\u80" "abc"]]
     set viewlist {}
     foreach s $l {
@@ -190,6 +189,5 @@ test lsort-4.26 {DefaultCompare procedure, signed characters} {
     }
     set viewlist
 } [list "abc" "abc\\200"]
-}
 
 testreport
diff --git a/tests/lsortcmd.test b/tests/lsortcmd.test
index fc6726b..ed53fe5 100644
--- a/tests/lsortcmd.test
+++ b/tests/lsortcmd.test
@@ -1,6 +1,4 @@
-source testing.tcl
-
-section "lsort -command"
+source [file dirname [info script]]/testing.tcl
 
 set list {b d a c z}
 
diff --git a/tests/misc.test b/tests/misc.test
index 0dc1112..ad9dd35 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -1,6 +1,6 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
-section "Regression Testing"
+needs constraint jim
 
 catch {unset a b}
 test regr-1.1 "Double dereference arrays" {
@@ -20,7 +20,7 @@ test regr-1.2 "Reference count shared literals" {
 	return 1
 } {1}
 
-test regr-1.3 "Invalid for expression" {
+test regr-1.3 "Invalid for expression" jim {
 	# Crashes with invalid expression
 	catch {
 		for {set i 0} {$i < n} {incr i} {
@@ -41,11 +41,9 @@ test regr-1.5 "lassign with empty list" {
 	info exists c
 } {1}
 
-section "I/O Testing"
-
 test io-1.1 "Read last line with no newline" {
 	set lines 0
-	set f [open testio.in]
+	set f [open $testdir/testio.in]
 	while {[gets $f buf] >= 0} {
 		incr lines
 	}
@@ -53,8 +51,6 @@ test io-1.1 "Read last line with no newline" {
 	list $lines
 } {2}
 
-section "unset"
-
 set g1 1
 set g2 2
 array set g3 {4 5 6 7}
@@ -111,8 +107,6 @@ proc test_unset {} {
 
 test_unset
 
-section "lrepeat"
-
 test lrepeat-1.1 "Basic tests" {
 	lrepeat 1 a
 } {a}
diff --git a/tests/perf.test b/tests/perf.test
index 83b13ae..145f432 100644
--- a/tests/perf.test
+++ b/tests/perf.test
@@ -1,3 +1,7 @@
+source [file dirname [info script]]/testing.tcl
+
+needs constraint manual
+
 set iterations 10000
 
 set version [info patchlevel]
@@ -129,3 +133,5 @@ bench "foreach: assign to dictsugar" {read_file_split_assign_foreach_dictsugar t
 bench "foreach: assign to dictsugar via lindex" {read_file_split_assign_lindex test.in}
 
 file delete test.in
+
+# testreport
diff --git a/tests/pid.test b/tests/pid.test
index c539fc4..4ce4d03 100644
--- a/tests/pid.test
+++ b/tests/pid.test
@@ -13,7 +13,9 @@
 #
 # RCS: @(#) $Id: pid.test,v 1.6 2000/04/10 17:19:03 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+
+needs cmd pid posix
 
 file delete test1
 
@@ -35,7 +37,7 @@ test pid-1.3 {pid command} {
     close $f
     set pids
 } {}
-test pid-1.4 {pid command} {
+test pid-1.4 {pid command} jim {
     list [catch {pid a b} msg] $msg
 } {1 {wrong # args: should be "pid ?chan?"}}
 test pid-1.5 {pid command} {
diff --git a/tests/proc-new.test b/tests/proc-new.test
index 324a976..077b43e 100644
--- a/tests/proc-new.test
+++ b/tests/proc-new.test
@@ -1,4 +1,6 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+
+needs constraint jim
 
 proc aproc {} {
 	list
@@ -25,8 +27,6 @@ proc hproc {{a aa} args} {
 	list a $a args $args
 }
 
-section "Proc - TIP #288"
-
 set n 1
 foreach {proc params result} {
 	aproc {} {}
diff --git a/tests/proc.test b/tests/proc.test
index 985f68b..916893e 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -16,7 +16,9 @@
 #
 # RCS: @(#) $Id: proc-old.test,v 1.6 2000/04/10 17:19:03 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+
+needs constraint jim
 
 catch {rename t1 ""}
 catch {rename foo ""}
diff --git a/tests/regcount.test b/tests/regcount.test
index 4b4d106..731bfc7 100644
--- a/tests/regcount.test
+++ b/tests/regcount.test
@@ -1,4 +1,8 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+
+needs cmd regexp
+testConstraint regexp_are [expr {[regexp {\d} 1]}]
+needs constraint regexp_are
 
 # Test regexp counted repetitions
 
diff --git a/tests/regexp.test b/tests/regexp.test
index c6d9a01..a198fc8 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -13,8 +13,9 @@
 #
 # RCS: @(#) $Id: regexp.test,v 1.30.2.1 2008/08/21 23:19:06 hobbs Exp $
 
-source testing.tcl
-package-or-skip regexp
+source [file dirname [info script]]/testing.tcl
+
+needs cmd regexp
 
 catch {unset foo}
 test regexp-1.1 {basic regexp operation} {
@@ -191,13 +192,13 @@ test regexp-5.5 {exercise cache of compiled expressions} {
     regexp .*e xe
 } 1
 
-test regexp-6.1 {regexp errors} {
+test regexp-6.1 {regexp errors} jim {
     list [catch {regexp a} msg] $msg
 } {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
-test regexp-6.2 {regexp errors} {
+test regexp-6.2 {regexp errors} jim {
     list [catch {regexp -nocase a} msg] $msg
 } {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
-test regexp-6.3 {regexp errors} {
+test regexp-6.3 {regexp errors} jim {
     list [catch {regexp -gorp a} msg] $msg
 } {1 {bad switch "-gorp": must be --, -all, -indices, -inline, -line, -nocase, or -start}}
 test regexp-6.4 {regexp errors} {
@@ -212,7 +213,7 @@ test regexp-6.6 {regexp errors} {
 test regexp-6.7 {regexp errors} {
     list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
 } {0 0}
-test regexp-6.8 {regexp errors} {
+test regexp-6.8 {regexp errors} jim {
     catch {unset f1}
     set f1 44
     list [catch {regexp abc abc f1(f2)} msg] $msg
@@ -347,25 +348,25 @@ test regexp-10.3 {newline sensitivity in regsub} {
 #    list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo
 #} "1 {da\nb123\nxb}"
 
-test regexp-11.1 {regsub errors} {
+test regexp-11.1 {regsub errors} jim {
     list [catch {regsub a b} msg] $msg
 } {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
-test regexp-11.2 {regsub errors} {
+test regexp-11.2 {regsub errors} jim {
     list [catch {regsub -nocase a b} msg] $msg
 } {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
-test regexp-11.3 {regsub errors} {
+test regexp-11.3 {regsub errors} jim {
     list [catch {regsub -nocase -all a b} msg] $msg
 } {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
-test regexp-11.4 {regsub errors} {
+test regexp-11.4 {regsub errors} jim {
     list [catch {regsub a b c d e f} msg] $msg
 } {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
-test regexp-11.5 {regsub errors} {
+test regexp-11.5 {regsub errors} jim {
     list [catch {regsub -gorp a b c} msg] $msg
 } {1 {bad switch "-gorp": must be --, -all, -line, -nocase, or -start}}
 test regexp-11.6 {regsub errors} {
     list [catch {regsub -nocase a( b c d} msg] [string match *parentheses* $msg]
 } {1 1}
-test regexp-11.7 {regsub errors} {
+test regexp-11.7 {regsub errors} jim {
     catch {unset f1}
     set f1 44
     list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
@@ -639,8 +640,8 @@ test regexp-21.13 {multiple matches handle newlines} {
     regexp -all -inline -indices -line -- ^ "a\nb\nc"
 } {{0 -1} {2 1} {4 3}}
 
-test regexp-22.1 {effect of caching} {
-	
+test regexp-22.1 {effect of caching} jim {
+
     set filedata {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
 
 	# Note: use 2 REs because often libc will cache a single regcomp() result
diff --git a/tests/regexp2.test b/tests/regexp2.test
index 2349a96..38fe88b 100644
--- a/tests/regexp2.test
+++ b/tests/regexp2.test
@@ -13,15 +13,11 @@
 #
 # RCS: @(#) $Id$
 
-source testing.tcl
-
-catch {package require regexp}
-if {[info commands regexp] eq "" || [regexp {\d} 1] == 0} {
-    # No regexp, or not using a sufficiently capable regexp implementation
-    puts "   --- skipped"
-    exit 0
-}
+source [file dirname [info script]]/testing.tcl
 
+needs cmd regexp
+testConstraint regexp_are [regexp {\d} 1]
+needs constraint regexp_are
 
 # Procedure to evaluate a script within a proc, to test compilation
 # functionality
diff --git a/tests/rename.test b/tests/rename.test
index 670637b..6b4afa5 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -13,7 +13,7 @@
 #
 # RCS: @(#) $Id: rename.test,v 1.8.2.1 2001/09/12 20:34:59 dgp Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 # Must eliminate the "unknown" command while the test is running,
 # especially if the test is being run in a program with its
diff --git a/tests/return.test b/tests/return.test
index 6fcef8c..94e38a3 100644
--- a/tests/return.test
+++ b/tests/return.test
@@ -1,4 +1,4 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 # return -code
 
@@ -46,3 +46,5 @@ test return-2.5 {return -level 1} {
 test return-2.6 {return -level 2} {
 	list [catch {b 2 20 text} msg] $msg
 } {20 text}
+
+testreport
diff --git a/tests/scan.test b/tests/scan.test
index 63e9751..0614d56 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -1,5 +1,3 @@
-source testing.tcl
-
 # Commands covered:  scan
 #
 # This file contains a collection of tests for one or more of the Tcl
@@ -15,10 +13,14 @@ source testing.tcl
 #
 # RCS: @(#) $Id: scan.test,v 1.10.2.2 2002/02/07 01:54:04 hobbs Exp $
 
+source [file dirname [info script]]/testing.tcl
+
+needs cmd scan
+
 test scan-1.1 {BuildCharSet, CharInSet} {
     list [scan foo {%[^o]} x] $x
 } {1 f}
-test scan-1.2 {BuildCharSet, CharInSet} {
+test scan-1.2 {BuildCharSet, CharInSet} jim {
     list [scan \]foo {%[]f]} x] $x
 } {1 {]f}}
 test scan-1.3 {BuildCharSet, CharInSet} {
@@ -67,7 +69,7 @@ test scan-3.4 {ValidateFormat} {
 test scan-3.5 {ValidateFormat} {
     list [catch {scan {} {%10c} a} msg] $msg
 } {1 {field width may not be specified in %c conversion}}
-test scan-3.6 {ValidateFormat} {
+test scan-3.6 {ValidateFormat} jim {
     list [catch {scan {} {%*1$d} a} msg] $msg
 } {1 {bad scan conversion character}}
 test scan-3.7 {ValidateFormat} {
@@ -92,10 +94,10 @@ test scan-3.13 {ValidateFormat} {
     list [catch {scan {} {%[^]a} x} msg] $msg
 } {1 {unmatched [ in format string}}
 
-test scan-4.1 {Tcl_ScanObjCmd, argument checks} {
+test scan-4.1 {Tcl_ScanObjCmd, argument checks} jim {
     list [catch {scan} msg] $msg
 } {1 {wrong # args: should be "scan string format ?varName varName ...?"}}
-test scan-4.2 {Tcl_ScanObjCmd, argument checks} {
+test scan-4.2 {Tcl_ScanObjCmd, argument checks} jim {
     list [catch {scan string} msg] $msg
 } {1 {wrong # args: should be "scan string format ?varName varName ...?"}}
 test scan-4.3 {Tcl_ScanObjCmd, argument checks} {
@@ -331,6 +333,7 @@ test scan-4.61 {Tcl_ScanObjCmd, set errors} {
 
 # procedure that returns the range of integers
 
+# On Tcl with bignum, these won't produce a result!
 proc int_range {} {
     for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
 	set MIN_INT [expr { $MIN_INT << 1 }]
@@ -339,13 +342,13 @@ proc int_range {} {
     return [list $MIN_INT $MAX_INT]
 }
 
-test scan-4.62 {scanning of large and negative octal integers} {
+test scan-4.62 {scanning of large and negative octal integers} jim {
     foreach { MIN_INT MAX_INT } [int_range] {}
     set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT]
     list [scan $scanstring {%o %o %o} a b c] \
 	[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
 } {3 1 1 1}
-test scan-4.63 {scanning of large and negative hex integers} {
+test scan-4.63 {scanning of large and negative hex integers} jim {
     foreach { MIN_INT MAX_INT } [int_range] {}
     set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT]
     list [scan $scanstring {%x %x %x} a b c] \
@@ -434,7 +437,7 @@ test scan-6.5 {floating-point scanning} {
     set a {}; set b {}; set c {}; set d {}
     list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
 } {4 4.6 99999.7 87.643 118.0}
-test scan-6.6 {floating-point scanning} {
+test scan-6.6 {floating-point scanning} jim {
     set a {}; set b {}; set c {}; set d {}
     list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
 } {4 1.2345 0.697 124.0 5e-05}
@@ -467,41 +470,38 @@ test scan-7.5 {string and character scanning} {
     set a {}; set b {}; set c {}
     list [scan "aaaaaabc aaabcdefg  + +  XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
 } {3 aabc bcdefg 43}
-ifutf8 {
-    test scan-7.6 {string and character scanning, unicode} {
-	set a {}; set b {}; set c {}; set d {}
-	list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
-    } "4 abc d\u00c7f ghijk dum"
-    test scan-7.7 {string and character scanning, unicode} {
-	set a {}; set b {}
-	list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b
-    } "2 199 99"
-    test scan-7.8 {string and character scanning, unicode} {
-	set a {}; set b {}
-	list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a
-    } "1 ab\ufeff"
-}
-
+test scan-7.6 {string and character scanning, unicode} utf8 {
+    set a {}; set b {}; set c {}; set d {}
+    list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
+} "4 abc d\u00c7f ghijk dum"
+test scan-7.7 {string and character scanning, unicode} utf8 {
+    set a {}; set b {}
+    list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b
+} "2 199 99"
+test scan-7.8 {string and character scanning, unicode} utf8 {
+    set a {}; set b {}
+    list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a
+} "1 ab\ufeff"
 test scan-8.1 {error conditions} {
     catch {scan a}
 } 1
-test scan-8.2 {error conditions} {
+test scan-8.2 {error conditions} jim {
     catch {scan a} msg
     set msg
 } {wrong # args: should be "scan string format ?varName varName ...?"}
-test scan-8.3 {error conditions} {
+test scan-8.3 {error conditions} jim {
     list [catch {scan a %D x} msg] $msg
 } {1 {bad scan conversion character}}
-test scan-8.4 {error conditions} {
+test scan-8.4 {error conditions} jim {
     list [catch {scan a %O x} msg] $msg
 } {1 {bad scan conversion character}}
-test scan-8.5 {error conditions} {
+test scan-8.5 {error conditions} jim {
     list [catch {scan a %X x} msg] $msg
 } {1 {bad scan conversion character}}
-test scan-8.6 {error conditions} {
+test scan-8.6 {error conditions} jim {
     list [catch {scan a %F x} msg] $msg
 } {1 {bad scan conversion character}}
-test scan-8.7 {error conditions} {
+test scan-8.7 {error conditions} jim {
     list [catch {scan a %E x} msg] $msg
 } {1 {bad scan conversion character}}
 test scan-8.8 {error conditions} {
diff --git a/tests/stacktrace.test b/tests/stacktrace.test
index 91dccbe..3f1428c 100644
--- a/tests/stacktrace.test
+++ b/tests/stacktrace.test
@@ -1,6 +1,6 @@
-package require testing
+source [file dirname [info script]]/testing.tcl
+needs constraint jim
 package require errors
-
 # Make this a proc so that the line numbers don't have to change
 proc main {} {
 	set id1 0
diff --git a/tests/string.test b/tests/string.test
index 220b70e..eecd18e 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -13,7 +13,7 @@
 #
 # RCS: @(#) $Id: string.test,v 1.23.2.1 2001/04/03 22:54:38 hobbs Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 # Some tests require the testobj command
 
@@ -207,29 +207,28 @@ test string-5.8 {string index} {
 test string-5.9 {string index} {
     string index abc end-1
 } b
-#test string-5.17 {string index, bad integer} {
-#    list [catch {string index "abc" 08} msg]
-#} {1}
-#test string-5.18 {string index, bad integer} {
-#    list [catch {string index "abc" end-00289} msg]
-#} {1}
-
-test string-6.1 {string is, too few args} {
+test string-5.17 {string index, bad integer} tcl {
+    list [catch {string index "abc" 08} msg]
+} {1}
+test string-5.18 {string index, bad integer} tcl {
+    list [catch {string index "abc" end-00289} msg]
+} {1}
+test string-6.1 {string is, too few args} jim {
     list [catch {string is} msg] $msg
 } {1 {wrong # args: should be "string is class ?-strict? str"}}
-test string-6.2 {string is, too few args} {
+test string-6.2 {string is, too few args} jim {
     list [catch {string is alpha} msg] $msg
 } {1 {wrong # args: should be "string is class ?-strict? str"}}
-test string-6.3 {string is, bad args} {
+test string-6.3 {string is, bad args} jim {
     list [catch {string is alpha -failin str} msg] $msg
 } {1 {wrong # args: should be "string is class ?-strict? str"}}
-test string-6.4 {string is, too many args} {
+test string-6.4 {string is, too many args} jim {
     list [catch {string is alpha -failin var -strict str more} msg] $msg
 } {1 {wrong # args: should be "string is class ?-strict? str"}}
-test string-6.5 {string is, class check} {
+test string-6.5 {string is, class check} jim {
     list [catch {string is bogus str} msg] $msg
 } {1 {bad class "bogus": must be alnum, alpha, ascii, control, digit, double, graph, integer, lower, print, punct, space, upper, or xdigit}}
-test string-6.6 {string is, ambiguous class} {
+test string-6.6 {string is, ambiguous class} jim {
     list [catch {string is al str} msg] $msg
 } {1 {ambiguous class "al": must be alnum, alpha, ascii, control, digit, double, graph, integer, lower, print, punct, space, upper, or xdigit}}
 test string-6.10 {string is, ok on empty} {
@@ -283,7 +282,7 @@ test string-6.35 {string is double, false} {
 test string-6.36 {string is double, false} {
     list [string is double  "\n"]
 } {0}
-test string-6.38 {string is double, false on underflow} {
+test string-6.38 {string is double, false on underflow} jim {
     list [string is double  123e-9999]
 } {0}
 test string-6.39 {string is double, false} {
@@ -406,12 +405,9 @@ test string-7.14 {string last, start index} {
 test string-7.15 {string last, start index} {
     string last \u00dca \u00dcad\u00dcad 0
 } -1
-ifutf8 {
-    test string-7.16 {string last, start index} {
-        string last \u00dca \u00dcad\u00dcad end-1
-    } 3
-}
-
+test string-7.16 {string last, start index} utf8 {
+    string last \u00dca \u00dcad\u00dcad end-1
+} 3
 test string-9.1 {string length} {
     list [catch {string length} msg]
 } {1}
@@ -600,10 +596,10 @@ test string-11.40 {string match, *special case} {
 test string-11.41 {string match, *special case} {
     string match {*[ab]*} abc
 } 1
-# XXX: I don't see why this shouldn't match. Changed result
-test string-11.42 {string match, *special case} {
+# I don't see why this shouldn't match. Ignored for jim
+test string-11.42 {string match, *special case} tcl {
     string match "*\\" "\\"
-} 1
+} 0
 test string-11.43 {string match, *special case} {
     string match "*\\\\" "\\"
 } 1
@@ -625,10 +621,10 @@ test string-11.48 {string match, *special case} {
 test string-11.49 {string match, *special case} {
     string match "?\\*" "a*"
 } 1
-# XXX: I don't see why this shouldn't match. Changed result
-test string-11.50 {string match, *special case} {
+# I don't see why this shouldn't match. Ignored for jim
+test string-11.50 {string match, *special case} jim {
     string match "\\" "\\"
-} 1
+} 0
 
 
 test string-12.1 {string range} {
diff --git a/tests/stringmatch.test b/tests/stringmatch.test
index b964ed4..dcb0586 100644
--- a/tests/stringmatch.test
+++ b/tests/stringmatch.test
@@ -9,7 +9,7 @@
 #
 # RCS: @(#) $Id: util.test,v 1.7.2.1 2001/07/16 23:14:13 hobbs Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 test stringmatch-5.1 {Tcl_StringMatch} {
     string match ab*c abc
@@ -35,13 +35,11 @@ test stringmatch-5.7 {Tcl_StringMatch: UTF-8} {
 test stringmatch-5.8 {Tcl_StringMatch} {
     string match a?c abc
 } 1
-ifutf8 {
-    test stringmatch-5.9 {Tcl_StringMatch: UTF-8} {
-        # skip one character in string
+test stringmatch-5.9 {Tcl_StringMatch: UTF-8} utf8 {
+    # skip one character in string
 
-        string match a?c a\u4e4fc
-    } 1
-}
+    string match a?c a\u4e4fc
+} 1
 test stringmatch-5.10 {Tcl_StringMatch} {
     string match a??c abc
 } 0
@@ -51,13 +49,11 @@ test stringmatch-5.11 {Tcl_StringMatch} {
 test stringmatch-5.12 {Tcl_StringMatch} {
     string match {[abc]bc} abc
 } 1
-ifutf8 {
-    test stringmatch-5.13 {Tcl_StringMatch: UTF-8} {
-        # string += Tcl_UtfToUniChar(string, &ch);
+test stringmatch-5.13 {Tcl_StringMatch: UTF-8} utf8 {
+    # string += Tcl_UtfToUniChar(string, &ch);
 
-        string match "\[\u4e4fxy\]bc" "\u4e4fbc"
-    } 1
-}
+    string match "\[\u4e4fxy\]bc" "\u4e4fbc"
+} 1
 test stringmatch-5.14 {Tcl_StringMatch} {
     # if ((*pattern == ']') || (*pattern == '\0'))
     # badly formed pattern
@@ -73,14 +69,12 @@ test stringmatch-5.15 {Tcl_StringMatch} {
 test stringmatch-5.16 {Tcl_StringMatch} {
     string match {a[abc]c} abc
 } 1
-ifutf8 {
-    test stringmatch-5.17 {Tcl_StringMatch: UTF-8} {
-        # pattern += Tcl_UtfToUniChar(pattern, &endChar);
-        # get 1 UTF-8 character
+test stringmatch-5.17 {Tcl_StringMatch: UTF-8} utf8 {
+    # pattern += Tcl_UtfToUniChar(pattern, &endChar);
+    # get 1 UTF-8 character
 
-        string match "a\[a\u4e4fc]c" "a\u4e4fc"
-    } 1
-}
+    string match "a\[a\u4e4fc]c" "a\u4e4fc"
+} 1
 test stringmatch-5.18 {Tcl_StringMatch: UTF-8} {
     # pattern += Tcl_UtfToUniChar(pattern, &endChar);
     # proper advance: wrong answer would match on UTF trail byte of \u4e4f
@@ -102,14 +96,12 @@ test stringmatch-5.21 {Tcl_StringMatch} {
 test stringmatch-5.22 {Tcl_StringMatch: UTF-8 range} {
     string match "\[\u4e00-\u4e4f]" "0"
 } 0
-ifutf8 {
-    test stringmatch-5.23 {Tcl_StringMatch: UTF-8 range} {
-        string match "\[\u4e00-\u4e4f]" "\u4e33"
-    } 1
-    test stringmatch-5.24 {Tcl_StringMatch: UTF-8 range} {
-        string match "\[\u4e00-\u4e4f]" "\uff08"
-    } 0
-}
+test stringmatch-5.23 {Tcl_StringMatch: UTF-8 range} utf8 {
+    string match "\[\u4e00-\u4e4f]" "\u4e33"
+} 1
+test stringmatch-5.24 {Tcl_StringMatch: UTF-8 range} utf8 {
+    string match "\[\u4e00-\u4e4f]" "\uff08"
+} 0
 test stringmatch-5.25 {Tcl_StringMatch} {
     string match {12[ab2-4cd]45} 12345
 } 1
@@ -164,11 +156,9 @@ test stringmatch-5.41 {Tcl_StringMatch: skip correct number of ']'} {
 test stringmatch-5.42 {Tcl_StringMatch: skip correct number of ']'} {
     string match {[A-]]x} \ue1x
 } 0
-ifutf8 {
-    test stringmatch-5.43 {Tcl_StringMatch: skip correct number of ']'} {
-        string match \[A-]\ue1]x \ue1x
-    } 1
-}
+test stringmatch-5.43 {Tcl_StringMatch: skip correct number of ']'} utf8 {
+    string match \[A-]\ue1]x \ue1x
+} 1
 test stringmatch-5.44 {Tcl_StringMatch: skip correct number of ']'} {
     string match {[A-]h]x} hx
 } 1
diff --git a/tests/subst.test b/tests/subst.test
index 4f29c6d..28a2af7 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -13,7 +13,7 @@
 #
 # RCS: @(#) $Id: subst.test,v 1.6.2.1 2001/04/03 22:54:38 hobbs Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 test subst-1.0 {basics} {
     subst {\$x}
diff --git a/tests/tailcall.test b/tests/tailcall.test
index eb097e5..7ee18c6 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.test
@@ -1,4 +1,6 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+needs constraint jim
+needs cmd tailcall
 
 test tailcall-1.1 {Basic tailcall} {
 	# Demo -- a tail-recursive factorial function
@@ -48,3 +50,5 @@ test tailcall-1.5 {interaction of uplevel and tailcall} {
 	}
 	a b
 } {c c}
+
+testreport
diff --git a/tests/testing.tcl b/tests/testing.tcl
index 33e3a7e..4bb19a5 100644
--- a/tests/testing.tcl
+++ b/tests/testing.tcl
@@ -1,3 +1,65 @@
+# Common code
+array set testinfo {verbose 0 numpass 0 numfail 0 numskip 0 numtests 0 failed {}}
+
+set testdir [file dirname [info script]]
+
+if {[lsearch $argv "-verbose"] >= 0 || [info exists env(testverbose)]} {
+	incr testinfo(verbose)
+}
+
+proc needs {type what {packages {}}} {
+	if {$type eq "constraint"} {
+		if {![info exists ::tcltest::testConstraints($what)]} {
+			set ::tcltest::testConstraints($what) 0
+		}
+		if {![set ::tcltest::testConstraints($what)]} {
+			skiptest " (constraint $what)"
+		}
+		return
+	}
+	if {$type eq "cmd"} {
+		# Does it exist already?
+		if {[info commands $what] ne ""} {
+			return
+		}
+		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
+		}
+		skiptest " (command $what)"
+	}
+	error "Unknown needs type: $type"
+}
+
+proc skiptest {{msg {}}} {
+	puts [format "%16s:   --- skipped$msg" $::argv0]
+	exit 0
+}
+
+# If tcl, just use tcltest
+if {[catch {info version}]} {
+	package require Tcl 8.5
+	package require tcltest 2.1
+	namespace import tcltest::*
+
+	if {$testinfo(verbose)} {
+		configure -verbose bps
+	}
+	testConstraint utf8 1
+	testConstraint tcl 1
+	proc testreport {} {
+		::tcltest::cleanupTests
+	}
+	return
+}
+
+# For Jim, this is reasonable compatible tcltest
 proc makeFile {contents name} {
 	set f [open $name w]
 	puts $f $contents
@@ -24,93 +86,82 @@ proc package-or-skip {name} {
 	if {[catch {
 		package require $name
 	}]} {
-		puts "   --- skipped"
+		puts [format "%16s:   --- skipped" $::argv0]
 		exit 0
 	}
 }
 
-set test(utf8) 0
-if {[string length "\xc2\xb5"] == 1} {
-	set test(utf8) 1
-}
-proc bytestring {x} {
-	return $x
+proc testConstraint {constraint bool} {
+	set ::tcltest::testConstraints($constraint) $bool
 }
 
-catch {
-	# Tcl-only things
-	info tclversion
-	proc errorInfo {msg} {
-		return $::errorInfo
-	}
-	proc error_source {} {
-	}
-	proc script_source {script} {
-	}
-	set test(utf8) 1
-	rename bytestring ""
-	package require tcltest
-	interp alias {} bytestring {} ::tcltest::bytestring
-}
-
-proc ifutf8 {code} {
-	if {$::test(utf8)} {
-		uplevel 1 $code
-	}
-}
+testConstraint {utf8} [expr {[string length "\xc2\xb5"] == 1}]
+testConstraint {references} [expr {[info commands ref] ne ""}]
+testConstraint {jim} 1
 
-proc section {name} {
-	if {!$::test(quiet)} {
-		puts "-- $name ----------------"
-	}
+proc bytestring {x} {
+	return $x
 }
 
-set test(numfail) 0
-set test(numpass) 0
-set test(failed) {}
-
-proc test {id descr script expected} {
-	if {!$::test(quiet)} {
+proc test {id descr script {constraints {}} expected} {
+	incr ::testinfo(numtests)
+	if {$::testinfo(verbose)} {
 		puts -nonewline "$id "
 	}
 
+	foreach c $constraints {
+		if {![info exists ::tcltest::testConstraints($c)]} {
+			incr ::testinfo(numskip)
+			if {$::testinfo(verbose)} {
+				puts "SKIP"
+			}
+			return
+		}
+	}
 	set rc [catch {uplevel 1 $script} result]
 
 	# Note that rc=2 is return
 	if {($rc == 0 || $rc == 2) && $result eq $expected} {
-		if {!$::test(quiet)} {
+		if {$::testinfo(verbose)} {
 			puts "OK  $descr"
 		}
-		incr ::test(numpass)
+		incr ::testinfo(numpass)
+		return
+	}
+
+	if {!$::testinfo(verbose)} {
+		puts -nonewline "$id "
+	}
+	puts "ERR $descr"
+	if {$rc == 0} {
+		set source [script_source $script]
 	} else {
-		if {$::test(quiet)} {
-			puts -nonewline "$id "
-		}
-		puts "ERR $descr"
-		if {$rc == 0} {
-			set source [script_source $script]
-		} else {
-			set source [error_source]
-		}
-		puts "Expected: '$expected'"
-		puts "Got     : '$result'"
-		incr ::test(numfail)
-		lappend ::test(failed) [list $id $descr $source $expected $result]
+		set source [error_source]
 	}
+	puts "Expected: '$expected'"
+	puts "Got     : '$result'"
+	incr ::testinfo(numfail)
+	lappend ::testinfo(failed) [list $id $descr $source $expected $result]
 }
 
 proc testreport {} {
-	if {!$::test(quiet) || $::test(numfail)} {
-		puts "----------------------------------------------------------------------"
-		puts "FAILED: $::test(numfail)"
-		foreach failed $::test(failed) {
+	if {$::testinfo(verbose)} {
+		puts -nonewline "\n$::argv0"
+	} else {
+		puts -nonewline [format "%16s" $::argv0]
+	}
+	puts [format ": Total %5d   Passed %5d  Skipped %5d  Failed %5d" \
+		$::testinfo(numtests) $::testinfo(numpass) $::testinfo(numskip) $::testinfo(numfail)]
+	if {$::testinfo(numfail)} {
+		puts [string repeat - 60]
+		puts "FAILED: $::testinfo(numfail)"
+		foreach failed $::testinfo(failed) {
 			foreach {id descr source expected result} $failed {}
 			puts "$source\t$id"
 		}
-		puts "PASSED: $::test(numpass)"
-		puts "----------------------------------------------------------------------\n"
+		puts [string repeat - 60]
 	}
-	if {$::test(numfail)} {
+	if {$::testinfo(numfail)} {
 		exit 1
 	}
 }
@@ -119,13 +170,6 @@ proc testerror {} {
 	error "deliberate error"
 }
 
-set test(quiet) [info exists ::env(testquiet)]
-if {[lindex $argv 0] eq "-quiet"} {
-	incr test(quiet)
-}
-
-if {!$test(quiet)} {
-	puts [string repeat = 40]
-	puts $argv0
-	puts [string repeat = 40]
+if {$testinfo(verbose)} {
+	puts "==== $argv0 ===="
 }
diff --git a/tests/timer.test b/tests/timer.test
index 1cbfc35..ffa55cc 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -15,8 +15,8 @@
 #
 # RCS: @(#) $Id: timer.test,v 1.7.2.1 2001/10/13 01:14:19 hobbs Exp $
 
-source testing.tcl
-package-or-skip eventloop
+source [file dirname [info script]]/testing.tcl
+needs cmd after eventloop
 
 test timer-1.1 {Tcl_CreateTimerHandler procedure} {
     foreach i [after info] {
@@ -173,10 +173,10 @@ test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
 test timer-6.1 {Tcl_AfterCmd procedure, basics} {
     list [catch {after} msg] $msg
 } {1 {wrong # args: should be "after option ?arg ...?"}}
-test timer-6.2 {Tcl_AfterCmd procedure, basics} {
+test timer-6.2 {Tcl_AfterCmd procedure, basics} jim {
     list [catch {after 2x} msg] $msg
 } {1 {bad argument "2x": must be cancel, idle, or info}}
-test timer-6.3 {Tcl_AfterCmd procedure, basics} {
+test timer-6.3 {Tcl_AfterCmd procedure, basics} jim {
     list [catch {after gorp} msg] $msg
 } {1 {bad argument "gorp": must be cancel, idle, or info}}
 test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
diff --git a/tests/tree.test b/tests/tree.test
index cd22916..90f7761 100644
--- a/tests/tree.test
+++ b/tests/tree.test
@@ -1,7 +1,5 @@
-package require testing
-package-or-skip tree
-
-section "tree"
+source [file dirname [info script]]/testing.tcl
+needs cmd tree
 
 proc dputs {msg} {
 	#puts $msg
@@ -113,3 +111,5 @@ test tree-2.3 "walk bfs" {
 } {rootnode childnode1 root.c2 root.c3 childnode2 n.c4 n.c5 n.c5.c6}
 
 $pt destroy
+
+testreport
diff --git a/tests/try.test b/tests/try.test
index 7435763..a2bb38a 100644
--- a/tests/try.test
+++ b/tests/try.test
@@ -1,4 +1,5 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
+needs cmd try tclcompat
 
 test try-1.1 "Simple case" {
 	try {
@@ -100,7 +101,11 @@ proc c {} {
 	try {
 		error here
 	} on error {msg opts} {
-		incr opts(-level)
+		# jim can do simply: 
+		if {[catch {incr opts(-level)}]} {
+			# Must be Tcl
+			dict incr opts -level
+		}
 		return {*}$opts $msg
 	}
 }
@@ -108,3 +113,5 @@ proc c {} {
 test try-3.1 "rethrow error in try/on handler" {
 	list [catch c msg] $msg
 } {1 here}
+
+testreport
diff --git a/tests/uplevel.test b/tests/uplevel.test
index 0d38c13..e91a5ea 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -13,7 +13,7 @@
 #
 # RCS: @(#) $Id: uplevel.test,v 1.6 2000/04/10 17:19:05 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 proc a {x y} {
     newset z [expr $x+$y]
diff --git a/tests/upvar.test b/tests/upvar.test
index cca8360..12318e3 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -13,7 +13,7 @@
 #
 # RCS: @(#) $Id: upvar.test,v 1.7 2000/04/10 17:19:05 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 test upvar-1.1 {reading variables with upvar} {
     proc p1 {a b} {set c 22; set d 33; p2}
@@ -287,7 +287,7 @@ test upvar-8.6 {errors in upvar command} {
     list [catch p1 msg] $msg
 } {1 {variable "a" already exists}}
 # Jim allows dicts within dicts. Tcl can't do this.
-test upvar-8.8 {create nested array with upvar} {
+test upvar-8.8 {create nested array with upvar} jim {
     proc p1 {} {upvar x(a) b; set b(2) 44}
     catch {unset x}
     p1
@@ -308,11 +308,11 @@ test upvar-9.2 {upvar redefine} {
     proc p1 {} { upvar a x; upvar b x; return $x }
     p1
 } 2
-test upvar-9.3 {upvar redefine static} {
+test upvar-9.3 {upvar redefine static} jim {
     proc p1 {} {{a 3}} { upvar b a; return $b }
     list [catch p1 msg] $msg
 } {1 {variable "a" already exists}}
-test upvar-9.4 {upvar links to static} {
+test upvar-9.4 {upvar links to static} jim {
     proc p1 {} {} { upvar a x; incr x; return $x }
     proc p2 {} {{a 3}} { list [p1] $a }
     p2
diff --git a/tests/utf8.test b/tests/utf8.test
index ecb5111..04c5b57 100644
--- a/tests/utf8.test
+++ b/tests/utf8.test
@@ -1,8 +1,6 @@
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
-ifutf8 {
-
-section "string tests"
+needs constraint utf8
 
 test utf8-1.1 "Pattern matching - ?" {
 	string match "abc?def" "abc\u00b5def"
@@ -128,4 +126,3 @@ test utf8-7.2 {append counts correctly} {
 } {8 12}
 
 testreport
-}
diff --git a/tests/utftcl.test b/tests/utftcl.test
index 468cff1..db058c2 100644
--- a/tests/utftcl.test
+++ b/tests/utftcl.test
@@ -10,9 +10,9 @@
 #
 # RCS: @(#) $Id: utf.test,v 1.14 2007/05/02 01:37:28 kennykb Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
-ifutf8 {
+needs constraint utf8
 
 catch {unset x}
 
@@ -286,5 +286,3 @@ test utf-17.1 {Tcl_UniCharToLower, no delta} {
 #} {1 1}
 
 testreport
-
-}
diff --git a/tests/while.test b/tests/while.test
index 5368b3e..de6d9b5 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -15,7 +15,7 @@
 #
 # RCS: @(#) $Id: while-old.test,v 1.6 2000/04/10 17:19:06 ericm Exp $
 
-source testing.tcl
+source [file dirname [info script]]/testing.tcl
 
 test while-old-1.1 {basic while loops} {
     set count 0
-- 
cgit v1.1