From 47412dd55bfb480602e28ca7d73b0aef74b622cb Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 9 Mar 2011 10:38:48 +0000
Subject: Update more of the test suite to use Tcltest 2.

---
 ChangeLog          |   5 +
 tests/dstring.test | 266 +++++++++++++++++++++++++++++++++++++----------------
 tests/init.test    |  64 +++++++------
 tests/link.test    | 154 ++++++++++++++++++-------------
 4 files changed, 317 insertions(+), 172 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 1820131..ab51db4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2011-03-09  Donal K. Fellows  <dkf@users.sf.net>
+
+	* tests/dstring.test, tests/init.test, tests/link.test: Update more of
+	the test suite to use Tcltest 2.
+
 2011-03-08  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tclBasic.c: Fix gcc warnings: variable set but not used
diff --git a/tests/dstring.test b/tests/dstring.test
index 95321ec..bcc304d 100644
--- a/tests/dstring.test
+++ b/tests/dstring.test
@@ -1,42 +1,54 @@
 # Commands covered:  none
 #
-# This file contains a collection of tests for Tcl's dynamic string
-# library procedures.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for Tcl's dynamic string library
+# procedures. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 1993 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
 testConstraint testdstring [llength [info commands testdstring]]
-
-test dstring-1.1 {appending and retrieving} testdstring {
+if {[testConstraint testdstring]} {
+    testdstring free
+}
+
+test dstring-1.1 {appending and retrieving} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "abc" -1
     list [testdstring get] [testdstring length]
-} {abc 3}
-test dstring-1.2 {appending and retrieving} testdstring {
+} -cleanup {
+    testdstring free
+} -result {abc 3}
+test dstring-1.2 {appending and retrieving} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "abc" -1
     testdstring append " xyzzy" 3
     testdstring append " 12345" -1
     list [testdstring get] [testdstring length]
-} {{abc xy 12345} 12}
-test dstring-1.3 {appending and retrieving} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{abc xy 12345} 12}
+test dstring-1.3 {appending and retrieving} -constraints testdstring -setup {
     testdstring free
+} -body {
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
     }
     list [testdstring get] [testdstring length]
-} {{aaaaaaaaaaaaaaaaaaaaa
+} -cleanup {
+    testdstring free
+} -result {{aaaaaaaaaaaaaaaaaaaaa
 bbbbbbbbbbbbbbbbbbbbb
 ccccccccccccccccccccc
 ddddddddddddddddddddd
@@ -54,101 +66,143 @@ ooooooooooooooooooooo
 ppppppppppppppppppppp
 } 352}
 
-test dstring-2.1 {appending list elements} testdstring {
+test dstring-2.1 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring element "abc"
     testdstring element "d e f"
     list [testdstring get] [testdstring length]
-} {{abc {d e f}} 11}
-test dstring-2.2 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{abc {d e f}} 11}
+test dstring-2.2 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring element "x"
     testdstring element "\{"
     testdstring element "ab\}"
     testdstring get
-} {x \{ ab\}}
-test dstring-2.3 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x \{ ab\}}
+test dstring-2.3 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l
     }
     testdstring get
-} {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
-test dstring-2.4 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
+test dstring-2.4 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append "a\{" -1
     testdstring element abc
     testdstring append "	\{" -1
     testdstring element xyzzy
     testdstring get
-} "a{ abc	{xyzzy"
-test dstring-2.5 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result "a{ abc	{xyzzy"
+test dstring-2.5 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append " \{" -1
     testdstring element abc
     testdstring get
-} " {abc"
-test dstring-2.6 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result " {abc"
+test dstring-2.6 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append " " -1
     testdstring element abc
     testdstring get
-} { abc}
-test dstring-2.7 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result { abc}
+test dstring-2.7 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "\\ " -1
     testdstring element abc
     testdstring get
-} "\\  abc"
-test dstring-2.8 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result "\\  abc"
+test dstring-2.8 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "x " -1
     testdstring element abc
     testdstring get
-} {x abc}
-test dstring-2.9 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result {x abc}
+test dstring-2.9 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring element #
     testdstring get
-} {{#}}
-test dstring-2.10 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{#}}
+test dstring-2.10 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append " " -1
     testdstring element #
     testdstring get
-} { {#}}
-test dstring-2.11 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result { {#}}
+test dstring-2.11 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append \t -1
     testdstring element #
     testdstring get
-} \t{#}
-test dstring-2.12 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result \t{#}
+test dstring-2.12 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append x -1
     testdstring element #
     testdstring get
-} {x #}
-test dstring-2.13 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x #}
+test dstring-2.13 {appending list elements} -constraints testdstring -body {
     # This test shows lack of sophistication in Tcl_DStringAppendElement's
     # decision about whether #-quoting can be disabled.
     testdstring free
     testdstring append "x " -1
     testdstring element #
     testdstring get
-} {x {#}}
+} -cleanup {
+    testdstring free
+} -result {x {#}}
 
-test dstring-3.1 {nested sublists} testdstring {
+test dstring-3.1 {nested sublists} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring start
     testdstring element foo
     testdstring element bar
     testdstring end
     testdstring element another
     testdstring get
-} {{foo bar} another}
-test dstring-3.2 {nested sublists} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{foo bar} another}
+test dstring-3.2 {nested sublists} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring start
     testdstring start
     testdstring element abc
@@ -157,9 +211,12 @@ test dstring-3.2 {nested sublists} testdstring {
     testdstring end
     testdstring element ghi
     testdstring get
-} {{{abc def}} ghi}
-test dstring-3.3 {nested sublists} testdstring {
+} -cleanup {
     testdstring free
+} -result {{{abc def}} ghi}
+test dstring-3.3 {nested sublists} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring start
     testdstring start
     testdstring start
@@ -171,9 +228,12 @@ test dstring-3.3 {nested sublists} testdstring {
     testdstring end
     testdstring element foo4
     testdstring get
-} {{{{foo foo2}} foo3} foo4}
-test dstring-3.4 {nested sublists} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{{{foo foo2}} foo3} foo4}
+test dstring-3.4 {nested sublists} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring element before
     testdstring start
     testdstring element during
@@ -181,52 +241,69 @@ test dstring-3.4 {nested sublists} testdstring {
     testdstring end
     testdstring element last
     testdstring get
-} {before {during more} last}
-test dstring-3.5 {nested sublists} testdstring {
+} -cleanup {
+    testdstring free
+} -result {before {during more} last}
+test dstring-3.5 {nested sublists} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring element "\{"
     testdstring start
     testdstring element first
     testdstring element second
     testdstring end
     testdstring get
-} {\{ {first second}}
-test dstring-3.6 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result {\{ {first second}}
+test dstring-3.6 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append x -1
     testdstring start
     testdstring element #
     testdstring end
     testdstring get
-} {x {{#}}}
-test dstring-3.7 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x {{#}}}
+test dstring-3.7 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append x -1
     testdstring start
     testdstring append " " -1
     testdstring element #
     testdstring end
     testdstring get
-} {x { {#}}}
-test dstring-3.8 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result {x { {#}}}
+test dstring-3.8 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append x -1
     testdstring start
     testdstring append \t -1
     testdstring element #
     testdstring end
     testdstring get
-} "x {\t{#}}"
-test dstring-3.9 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result "x {\t{#}}"
+test dstring-3.9 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append x -1
     testdstring start
     testdstring append x -1
     testdstring element #
     testdstring end
     testdstring get
-} {x {x #}}
-test dstring-3.10 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x {x #}}
+test dstring-3.10 {appending list elements} -constraints testdstring -body {
     # This test shows lack of sophistication in Tcl_DStringAppendElement's
     # decision about whether #-quoting can be disabled.
     testdstring free
@@ -236,36 +313,50 @@ test dstring-3.10 {appending list elements} testdstring {
     testdstring element #
     testdstring end
     testdstring get
-} {x {x {#}}}
+} -cleanup {
+    testdstring free
+} -result {x {x {#}}}
 
-test dstring-4.1 {truncation} testdstring {
+test dstring-4.1 {truncation} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "abcdefg" -1
     testdstring trunc 3
     list [testdstring get] [testdstring length]
-} {abc 3}
-test dstring-4.2 {truncation} testdstring {
+} -cleanup {
+    testdstring free
+} -result {abc 3}
+test dstring-4.2 {truncation} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "xyzzy" -1
     testdstring trunc 0
     list [testdstring get] [testdstring length]
-} {{} 0}
+} -cleanup {
+    testdstring free
+} -result {{} 0}
 
-test dstring-5.1 {copying to result} testdstring {
+test dstring-5.1 {copying to result} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append xyz -1
     testdstring result
-} xyz
-test dstring-5.2 {copying to result} testdstring {
+} -cleanup {
+    testdstring free
+} -result xyz
+test dstring-5.2 {copying to result} -constraints testdstring -setup {
     testdstring free
-    catch {unset a}
+    unset -nocomplain a
+} -body {
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
     }
     set a [testdstring result]
     testdstring append abc -1
     list $a [testdstring get]
-} {{aaaaaaaaaaaaaaaaaaaaa
+} -cleanup {
+    testdstring free
+} -result {{aaaaaaaaaaaaaaaaaaaaa
 bbbbbbbbbbbbbbbbbbbbb
 ccccccccccccccccccccc
 ddddddddddddddddddddd
@@ -283,23 +374,31 @@ ooooooooooooooooooooo
 ppppppppppppppppppppp
 } abc}
 
-test dstring-6.1 {Tcl_DStringGetResult} testdstring {
+test dstring-6.1 {Tcl_DStringGetResult} -constraints testdstring -setup {
     testdstring free
+} -body {
     list [testdstring gresult staticsmall] [testdstring get]
-} {{} short}
-test dstring-6.2 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
     testdstring free
+} -result {{} short}
+test dstring-6.2 {Tcl_DStringGetResult} -constraints testdstring -setup {
+    testdstring free
+} -body {
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
     }
     list [testdstring gresult staticsmall] [testdstring get]
-} {{} short}
-test dstring-6.3 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{} short}
+test dstring-6.3 {Tcl_DStringGetResult} -constraints testdstring -body {
     set result {}
     lappend result [testdstring gresult staticlarge]
     testdstring append x 1
     lappend result [testdstring get]
-} {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
+} -cleanup {
+    testdstring free
+} -result {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
 second0 second1 second2 second3 second4 second5 second6 second7 second8 second9
 third0 third1 third2 third3 third4 third5 third6 third7 third8 third9
 fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9
@@ -307,22 +406,31 @@ fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9
 sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9
 seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9
 x}}
-test dstring-6.4 {Tcl_DStringGetResult} testdstring {
+test dstring-6.4 {Tcl_DStringGetResult} -constraints testdstring -body {
     set result {}
     lappend result [testdstring gresult free]
     testdstring append y 1
     lappend result [testdstring get]
-} {{} {This is a malloc-ed stringy}}
-test dstring-6.5 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{} {This is a malloc-ed stringy}}
+test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body {
     set result {}
     lappend result [testdstring gresult special]
     testdstring append z 1
     lappend result [testdstring get]
-} {{} {This is a specially-allocated stringz}}
-
+} -cleanup {
+    testdstring free
+} -result {{} {This is a specially-allocated stringz}}
+
 # cleanup
 if {[testConstraint testdstring]} {
     testdstring free
 }
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/init.test b/tests/init.test
index 6b61c06..40fa507 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
@@ -45,33 +45,37 @@ test init-1.7 {auto_qualify - multiples colons 1} {
 test init-1.8 {auto_qualify - multiple colons 2} {
     auto_qualify :::foo ::bar
 } foo
-
+
 # We use a sub-interp and auto_reset and double the tests because there is 2
 # places where auto_loading occur (before loading the indexes files and after)
 
 set testInterp [interp create]
 interp eval $testInterp [list set argv $argv]
-interp eval $testInterp [list package require tcltest]
-interp eval $testInterp [list namespace import -force ::tcltest::*]
-
+interp eval $testInterp {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+    customMatch pairwise {apply {{mode pair} {
+	if {[llength $pair] != 2} {error "need a pair of values to check"}
+	string $mode [lindex $pair 0] [lindex $pair 1]
+    }}}
+}
+# TODO: Connect result reporting to master interp
 interp eval $testInterp {
 
 auto_reset
 catch {rename parray {}}
-
-test init-2.0 {load parray - stage 1} {
-    set ret [catch {parray} error]
+
+test init-2.0 {load parray - stage 1} -body {
+    parray
+} -returnCodes error -cleanup {
     rename parray {}  ;# remove it, for the next test - that should not fail.
-    list $ret $error
-} {1 {wrong # args: should be "parray a ?pattern?"}}
-test init-2.1 {load parray - stage 2} {
-    set ret [catch {parray} error]
-    list $ret $error
-} {1 {wrong # args: should be "parray a ?pattern?"}}
+} -result {wrong # args: should be "parray a ?pattern?"}
+test init-2.1 {load parray - stage 2} -body {
+    parray
+} -returnCodes error -result {wrong # args: should be "parray a ?pattern?"}
 auto_reset
 catch {rename ::safe::setLogCmd {}}
-#unset auto_index(::safe::setLogCmd)
-#unset auto_oldpath
+#unset -nocomplain auto_index(::safe::setLogCmd) auto_oldpath
 test init-2.2 {load ::safe::setLogCmd - stage 1} {
     ::safe::setLogCmd
     rename ::safe::setLogCmd {}  ;# should not fail
@@ -105,18 +109,18 @@ test init-2.8 {load tcl::HistAdd} -setup {
     catch {rename ::tcl::HistAdd {}}
 } -body {
     # 3 ':' on purpose
-    list [catch {tcl:::HistAdd} error] $error
-} -cleanup {
+    tcl:::HistAdd
+} -returnCodes error -cleanup {
     rename ::tcl::HistAdd {}
-} -result {1 {wrong # args: should be "tcl:::HistAdd event ?exec?"}}
-
+} -result {wrong # args: should be "tcl:::HistAdd event ?exec?"}
+
 test init-3.0 {random stuff in the auto_index, should still work} {
     set auto_index(foo:::bar::blah) {
         namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
     }
     foo:::bar::blah
 } 1
-
+
 # Tests that compare the error stack trace generated when autoloading with
 # that generated when no autoloading is necessary.  Ideally they should be the
 # same.
@@ -145,29 +149,29 @@ foreach arg [subst -nocommands -novariables {
 		{argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
 	}] {
 
-    test init-4.$count.0 {::errorInfo produced by [unknown]} {
+    test init-4.$count.0 {::errorInfo produced by [unknown]} -setup {
 	auto_reset
+    } -body {
 	catch {parray a b $arg}
 	set first $::errorInfo
 	catch {parray a b $arg}
-	set second $::errorInfo
-	string equal $first $second
-    } 1
-    test init-4.$count.1 {::errorInfo produced by [unknown]} {
+	list $first $::errorInfo
+    } -match pairwise -result equal
+    test init-4.$count.1 {::errorInfo produced by [unknown]} -setup {
 	auto_reset
+    } -body {
 	namespace eval junk [list array set $arg [list 1 2 3 4]]
 	trace variable ::junk::$arg r \
 		"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
 	catch {parray ::junk::$arg}
 	set first $::errorInfo
 	catch {parray ::junk::$arg}
-	set second $::errorInfo
-	string equal $first $second
-    } 1
+	list $first $::errorInfo
+    } -match pairwise -result equal
 
     incr count
 }
-
+
 test init-5.0 {return options passed through ::unknown} -setup {
     catch {rename xxx {}}
     set ::auto_index(::xxx) {proc ::xxx {} {
diff --git a/tests/link.test b/tests/link.test
index 3b423ec..60d0799 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -1,17 +1,17 @@
 # Commands covered:  none
 #
-# This file contains a collection of tests for Tcl_LinkVar and related
-# library procedures.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for Tcl_LinkVar and related library
+# procedures. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 1993 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
@@ -19,23 +19,27 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 testConstraint testlink [llength [info commands testlink]]
 
 foreach i {int real bool string} {
-    catch {unset $i}
+    unset -nocomplain $i
 }
-test link-1.1 {reading C variables from Tcl} {testlink} {
+
+test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list $int $real $bool $string $wide
-} {43 1.23 1 NULL 12341234}
-test link-1.2 {reading C variables from Tcl} {testlink} {
+} -result {43 1.23 1 NULL 12341234}
+test link-1.2 {reading C variables from Tcl} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     testlink set -3 2 0 "A long string with spaces"  43214321 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     list $int $real $bool $string $wide $int $real $bool $string $wide
-} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
+} -result {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
 
-test link-2.1 {writing C variables from Tcl} {testlink} {
+test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     set int "0o0721"
@@ -53,34 +57,39 @@ test link-2.1 {writing C variables from Tcl} {testlink} {
     set float 1.0987654321
     set uwide 357357357357
     concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
-test link-2.2 {writing bad values into variables} {testlink} {
+} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
+test link-2.2 {writing bad values into variables} -setup {
     testlink delete
+} -constraints {testlink} -body {
     testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set int 09a} msg] $msg $int
-} {1 {can't set "int": variable must have integer value} 43}
-test link-2.3 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "int": variable must have integer value} 43}
+test link-2.3 {writing bad values into variables} -setup {
     testlink delete
+} -constraints {testlink} -body {
     testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set real 1.x3} msg] $msg $real
-} {1 {can't set "real": variable must have real value} 1.23}
-test link-2.4 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "real": variable must have real value} 1.23}
+test link-2.4 {writing bad values into variables} -setup {
     testlink delete
+} -constraints {testlink} -body {
     testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set bool gorp} msg] $msg $bool
-} {1 {can't set "bool": variable must have boolean value} 1}
-test link-2.5 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "bool": variable must have boolean value} 1}
+test link-2.5 {writing bad values into variables} -setup {
     testlink delete
+} -constraints {testlink} -body {
     testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set wide gorp} msg] $msg $bool
-} {1 {can't set "wide": variable must have integer value} 1}
+} -result {1 {can't set "wide": variable must have integer value} 1}
 
-test link-3.1 {read-only variables} {testlink} {
+test link-3.1 {read-only variables} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0
     list [catch {set int 4} msg] $msg $int \
@@ -88,9 +97,10 @@ test link-3.1 {read-only variables} {testlink} {
 	[catch {set bool no} msg] $msg $bool \
 	[catch {set string "new value"} msg] $msg $string \
 	[catch {set wide 12341234} msg] $msg $wide
-} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
-test link-3.2 {read-only variables} {testlink} {
+} -result {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
+test link-3.2 {read-only variables} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0
     list [catch {set int 4} msg] $msg $int \
@@ -98,19 +108,21 @@ test link-3.2 {read-only variables} {testlink} {
 	[catch {set bool no} msg] $msg $bool \
 	[catch {set string "new value"} msg] $msg $string\
 	[catch {set wide 12341234} msg] $msg $wide
-} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}
+} -result {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}
 
-test link-4.1 {unsetting linked variables} {testlink} {
+test link-4.1 {unsetting linked variables} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     unset int real bool string wide
     list [catch {set int} msg] $msg [catch {set real} msg] $msg \
 	    [catch {set bool} msg] $msg [catch {set string} msg] $msg \
 	    [catch {set wide} msg] $msg
-} {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
-test link-4.2 {unsetting linked variables} {testlink} {
+} -result {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
+test link-4.2 {unsetting linked variables} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink set -6 -2.1 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     unset int real bool string wide
@@ -120,10 +132,11 @@ test link-4.2 {unsetting linked variables} {testlink} {
     set string newValue
     set wide 333555
     lrange [testlink get] 0 4
-} {102 16.0 1 newValue 333555}
+} -result {102 16.0 1 newValue 333555}
 
-test link-5.1 {unlinking variables} {testlink} {
+test link-5.1 {unlinking variables} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink set -6 -2.25 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink delete
     set int xx1
@@ -141,98 +154,108 @@ test link-5.1 {unlinking variables} {testlink} {
     set float dskjfbjfd
     set uwide isdfsngs
     testlink get
-} {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
-test link-5.2 {unlinking variables} {testlink} {
+} -result {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
+test link-5.2 {unlinking variables} -constraints {testlink} -setup {
     testlink delete
+} -body {
     testlink set -6 -2.25 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     testlink delete
     testlink set 25 14.7 7 - 999999 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
     list $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
+} -result {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
 
-test link-6.1 {errors in setting up link} {testlink} {
+test link-6.1 {errors in setting up link} -setup {
     testlink delete
-    catch {unset int}
+    unset -nocomplain int
+} -constraints {testlink} -body {
     set int(44) 1
-    list [catch {testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1} msg] $msg
-} {1 {can't set "int": variable is array}}
-catch {unset int}
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+} -cleanup {
+    unset -nocomplain int
+} -returnCodes error -result {can't set "int": variable is array}
 
-test link-7.1 {access to linked variables via upvar} {testlink} {
+test link-7.1 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar int y
 	unset y
     }
-    testlink delete
     testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
     testlink set 14 {} {} {} {} {} {} {} {} {} {} {} {} {}
     x
     list [catch {set int} msg] $msg
-} {0 14}
-test link-7.2 {access to linked variables via upvar} {testlink} {
+} -result {0 14}
+test link-7.2 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar int y
 	return [set y]
     }
-    testlink delete
     testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
     testlink set 0 {} {} {} {} {} {} {} {} {} {} {} {} {}
     set int
     testlink set 23 {} {} {} {} {} {} {} {} {} {} {} {} {}
     x
     list [x] $int
-} {23 23}
-test link-7.3 {access to linked variables via upvar} {testlink} {
+} -result {23 23}
+test link-7.3 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar int y
 	set y 44
     }
-    testlink delete
     testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
     testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $int
-} {1 {can't set "y": linked variable is read-only} 11}
-test link-7.4 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": linked variable is read-only} 11}
+test link-7.4 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar int y
 	set y abc
     }
-    testlink delete
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $int
-} {1 {can't set "y": variable must have integer value} -4}
-test link-7.5 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have integer value} -4}
+test link-7.5 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar real y
 	set y abc
     }
-    testlink delete
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $real
-} {1 {can't set "y": variable must have real value} 16.75}
-test link-7.6 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have real value} 16.75}
+test link-7.6 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar bool y
 	set y abc
     }
-    testlink delete
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $bool
-} {1 {can't set "y": variable must have boolean value} 1}
-test link-7.7 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have boolean value} 1}
+test link-7.7 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar wide y
 	set y abc
     }
-    testlink delete
     testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $wide
-} {1 {can't set "y": variable must have integer value} 778899}
+} -result {1 {can't set "y": variable must have integer value} 778899}
 
 test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
     proc x args {
@@ -245,7 +268,7 @@ test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
     trace var int w x
     testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
     trace vdelete int w x
-    set x
+    return $x
 } {{int {} w} 32 -2.0 0 xyzzy 995511}
 test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
     proc x args {
@@ -259,7 +282,7 @@ test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
     trace var int w x
     testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
     trace vdelete int w x
-    set x
+    return $x
 } {}
 test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
     testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
@@ -267,13 +290,18 @@ test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
 	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
     } msg] $msg $int
 } {0 {} 47}
-
+
 catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0}
 catch {testlink delete}
 foreach i {int real bool string wide} {
-    catch {unset $i}
+    unset -nocomplain $i
 }
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
-- 
cgit v0.12