Some fixes. Still broken on 64-bit systems

1 files changed, 193 insertions, 224 deletions

diff --git a/tests/link.test b/tests/link.test
index 1f40189..e0f7e3c 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -400,31 +400,27 @@ test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
     } msg] $msg $int
 } {0 {} 47}
 
-test link-9.1 {linkarray usage messages} {
+test link-9.1 {linkarray usage messages} -setup {
     set mylist [list]
-    catch {testlinkarray} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {testlinkarray x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {testlinkarray update} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {testlinkarray remove} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {testlinkarray create} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {testlinkarray create xx 1 my} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {testlinkarray create char* 0 my} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+} -body {
+    catch {testlinkarray} msg
+    lappend mylist $msg
+    catch {testlinkarray x} msg
+    lappend mylist $msg
+    catch {testlinkarray update} msg
+    lappend mylist $msg
+    catch {testlinkarray remove} msg
+    lappend mylist $msg
+    catch {testlinkarray create} msg
+    lappend mylist $msg
+    catch {testlinkarray create xx 1 my} msg
+    lappend mylist $msg
+    catch {testlinkarray create char* 0 my} msg
+    lappend mylist $msg
     join $mylist "\n"
-} {wrong # args: should be "testlinkarray option args"
+} -cleanup {
+    unset -nocomplain my
+} -result {wrong # args: should be "testlinkarray option args"
 bad option "x": must be update, remove, or create
 
 
@@ -432,93 +428,87 @@ wrong # args: should be "testlinkarray create ?-readonly? type size name ?addres
 bad type "xx": must be char, uchar, short, ushort, int, uint, long, ulong, wide, uwide, float, double, string, char*, or binary
 wrong array size given}
 
-test link-10.1 {linkarray char*} {
+test link-10.1 {linkarray char*} -setup {
     set mylist [list]
+} -body {
     testlinkarray create char* 1 ::my(var)
     lappend mylist [set ::my(var) ""]
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create char* 4 ::my(var)
     set ::my(var) x
-    catch {set ::my(var) xyzz} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) xyzz} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create -r char* 4 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {
+} -cleanup {
+    unset -nocomplain my
+} -result {
 can't set "::my(var)": wrong size of char* value
 can't set "::my(var)": wrong size of char* value
 can't set "::my(var)": linked variable is read-only}
 
-test link-11.1 {linkarray char} {
+test link-11.1 {linkarray char} -setup {
     set mylist [list]
+} -body {
     testlinkarray create char 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 1234} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 1234} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create char 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r char 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have char value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have char value
 120
 can't set "::my(var)": variable must have char value
 can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-12.1 {linkarray unsigned char} {
+test link-12.1 {linkarray unsigned char} -setup {
     set mylist [list]
+} -body {
     testlinkarray create uchar 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 1234} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {set ::my(var) -1} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 1234} msg
+    lappend mylist $msg
+    catch {set ::my(var) -1} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create uchar 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r uchar 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have unsigned char value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have unsigned char value
 120
 can't set "::my(var)": variable must have unsigned char value
 can't set "::my(var)": variable must have unsigned char value
@@ -526,67 +516,62 @@ can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-13.1 {linkarray short} {
+test link-13.1 {linkarray short} -setup {
     set mylist [list]
+} -body {
     testlinkarray create short 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 123456} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 123456} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create short 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r short 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have short value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have short value
 120
 can't set "::my(var)": variable must have short value
 can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-14.1 {linkarray unsigned short} {
+test link-14.1 {linkarray unsigned short} -setup {
     set mylist [list]
+} -body {
     testlinkarray create ushort 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 123456} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {set ::my(var) -1} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 123456} msg
+    lappend mylist $msg
+    catch {set ::my(var) -1} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create ushort 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r ushort 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have unsigned short value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have unsigned short value
 120
 can't set "::my(var)": variable must have unsigned short value
 can't set "::my(var)": variable must have unsigned short value
@@ -594,67 +579,62 @@ can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-15.1 {linkarray int} {
+test link-15.1 {linkarray int} -setup {
     set mylist [list]
+} -body {
     testlinkarray create int 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 1e3} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 1e3} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create int 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r int 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have integer value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have integer value
 120
 can't set "::my(var)": variable must have integer value
 can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-16.1 {linkarray unsigned int} {
+test link-16.1 {linkarray unsigned int} -setup {
     set mylist [list]
+} -body {
     testlinkarray create uint 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 1e33} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {set ::my(var) -1} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
+    catch {set ::my(var) -1} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create uint 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r uint 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have unsigned int value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have unsigned int value
 120
 can't set "::my(var)": variable must have unsigned int value
 can't set "::my(var)": variable must have unsigned int value
@@ -662,135 +642,125 @@ can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-17.1 {linkarray long} {
+test link-17.1 {linkarray long} -setup {
     set mylist [list]
+} -body {
     testlinkarray create long 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 1e33} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create long 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r long 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have long value
+} -cleanup {
+    unset -nocomplain my
+} -match glob -result {can't set "::my(var)": variable must have * value
 120
-can't set "::my(var)": variable must have long value
+can't set "::my(var)": variable must have * value
 can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-18.1 {linkarray unsigned long} {
+test link-18.1 {linkarray unsigned long} -setup {
     set mylist [list]
+} -body {
     testlinkarray create ulong 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 1e33} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {set ::my(var) -1} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
+    catch {set ::my(var) -1} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create ulong 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r ulong 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have unsigned long value
+} -cleanup {
+    unset -nocomplain my
+} -match glob -result {can't set "::my(var)": variable must have unsigned * value
 120
-can't set "::my(var)": variable must have unsigned long value
-can't set "::my(var)": variable must have unsigned long value
+can't set "::my(var)": variable must have unsigned * value
+can't set "::my(var)": variable must have unsigned * value
 can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-19.1 {linkarray wide} {
+test link-19.1 {linkarray wide} -setup {
     set mylist [list]
+} -body {
     testlinkarray create wide 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 1e33} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create wide 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r wide 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have wide integer value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have wide integer value
 120
 can't set "::my(var)": variable must have wide integer value
 can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-20.1 {linkarray unsigned wide} {
+test link-20.1 {linkarray unsigned wide} -setup {
     set mylist [list]
+} -body {
     testlinkarray create uwide 1 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     lappend mylist [set ::my(var) 120]
-    catch {set ::my(var) 1e33} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {set ::my(var) -1} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) 1e33} msg
+    lappend mylist $msg
+    catch {set ::my(var) -1} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
     testlinkarray create uwide 4 ::my(var)
-    catch {set ::my(var) {1 2 3}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2 3}} msg
+    lappend mylist $msg
     set ::my(var) {1 2 3 4}
     lappend mylist $my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r uwide 2 ::my(var)
-    catch {set ::my(var) {1 2}} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) {1 2}} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": variable must have unsigned wide int value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": variable must have unsigned wide int value
 120
 can't set "::my(var)": variable must have unsigned wide int value
 can't set "::my(var)": variable must have unsigned wide int value
@@ -798,52 +768,51 @@ can't set "::my(var)": wrong dimension
 1 2 3 4
 can't set "::my(var)": linked variable is read-only}
 
-test link-21.1 {linkarray string} {
+test link-21.1 {linkarray string} -setup {
     set mylist [list]
+} -body {
     testlinkarray create string 1 ::my(var)
     lappend mylist [set ::my(var) ""]
     lappend mylist [set ::my(var) "xyz"]
     lappend mylist $::my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r string 4 ::my(var)
-    catch {set ::my(var) x} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) x} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {
+} -cleanup {
+    unset -nocomplain my
+} -result {
 xyz
 xyz
 can't set "::my(var)": linked variable is read-only}
 
-test link-22.1 {linkarray binary} {
+test link-22.1 {linkarray binary} -setup {
     set mylist [list]
+} -body {
     testlinkarray create binary 1 ::my(var)
     set ::my(var) x
-    catch {set ::my(var) xy} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) xy} msg
+    lappend mylist $msg
     lappend mylist $::my(var)
     testlinkarray remove ::my(var)
     testlinkarray create binary 4 ::my(var)
-    catch {set ::my(var) abc} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
-    catch {set ::my(var) abcde} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) abc} msg
+    lappend mylist $msg
+    catch {set ::my(var) abcde} msg
+    lappend mylist $msg
     set ::my(var) abcd
     lappend mylist $::my(var)
     testlinkarray remove ::my(var)
     testlinkarray create -r binary 4 ::my(var)
-    catch {set ::my(var) xyzv} my(msg)
-    lappend mylist $my(msg)
-    unset my(msg)
+    catch {set ::my(var) xyzv} msg
+    lappend mylist $msg
     testlinkarray remove ::my(var)
-    unset my
     join $mylist "\n"
-} {can't set "::my(var)": wrong size of binary value
+} -cleanup {
+    unset -nocomplain my
+} -result {can't set "::my(var)": wrong size of binary value
 x
 can't set "::my(var)": wrong size of binary value
 can't set "::my(var)": wrong size of binary value