diff options
Diffstat (limited to 'tests/link.test')
| -rw-r--r-- | tests/link.test | 357 |
1 files changed, 205 insertions, 152 deletions
diff --git a/tests/link.test b/tests/link.test index 0a865d8..97bd631 100644 --- a/tests/link.test +++ b/tests/link.test @@ -400,33 +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} -setup { - set mylist [list] -} -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" -} -cleanup { - unset -nocomplain my -} -result {wrong # args: should be "testlinkarray option args" -bad option "x": must be update, remove, or create - - -wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?" -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-9.1 {linkarray usage messages} -returnCodes error -body { + testlinkarray +} -result {wrong # args: should be "testlinkarray option args"} +test link-9.2 {linkarray usage messages} -returnCodes error -body { + testlinkarray x +} -result {bad option "x": must be update, remove, or create} +test link-9.3 {linkarray usage messages} -body { + testlinkarray update +} -result {} +test link-9.4 {linkarray usage messages} -body { + testlinkarray remove +} -result {} +test link-9.5 {linkarray usage messages} -returnCodes error -body { + testlinkarray create +} -result {wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?"} +test link-9.6 {linkarray usage messages} -returnCodes error -body { + testlinkarray create xx 1 my +} -result {bad type "xx": must be char, uchar, short, ushort, int, uint, long, ulong, wide, uwide, float, double, string, char*, or binary} +test link-9.7 {linkarray usage messages} -returnCodes error -body { + testlinkarray create char* 0 my +} -result {wrong array size given} test link-10.1 {linkarray char*} -setup { set mylist [list] @@ -435,23 +429,27 @@ test link-10.1 {linkarray char*} -setup { lappend mylist [set ::my(var) ""] catch {set ::my(var) x} msg lappend mylist $msg +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{} {can't set "::my(var)": wrong size of char* value}} +test link-10.2 {linkarray char*} -body { testlinkarray create char* 4 ::my(var) set ::my(var) x catch {set ::my(var) xyzz} msg - lappend mylist $msg + return $msg +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {can't set "::my(var)": wrong size of char* value} +test link-10.3 {linkarray char*} -body { testlinkarray create -r char* 4 ::my(var) catch {set ::my(var) x} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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} +} -result {can't set "::my(var)": linked variable is read-only} test link-11.1 {linkarray char} -setup { set mylist [list] @@ -462,26 +460,30 @@ test link-11.1 {linkarray char} -setup { lappend mylist [set ::my(var) 120] catch {set ::my(var) 1234} msg lappend mylist $msg +} -cleanup { testlinkarray remove ::my(var) + 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}} +test link-11.2 {linkarray char} -setup { + set mylist [list] +} -body { testlinkarray create char 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-11.3 {linkarray char} -body { testlinkarray create -r char 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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} +} -result {can't set "::my(var)": linked variable is read-only} test link-12.1 {linkarray unsigned char} -setup { set mylist [list] @@ -494,27 +496,30 @@ test link-12.1 {linkarray unsigned char} -setup { lappend mylist $msg catch {set ::my(var) -1} msg lappend mylist $msg +} -cleanup { testlinkarray remove ::my(var) + 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}} +test link-12.2 {linkarray unsigned char} -setup { + set mylist [list] +} -body { testlinkarray create uchar 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-12.3 {linkarray unsigned char} -body { testlinkarray create -r uchar 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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 -can't set "::my(var)": wrong dimension -1 2 3 4 -can't set "::my(var)": linked variable is read-only} +} -result {can't set "::my(var)": linked variable is read-only} test link-13.1 {linkarray short} -setup { set mylist [list] @@ -525,26 +530,30 @@ test link-13.1 {linkarray short} -setup { lappend mylist [set ::my(var) 120] catch {set ::my(var) 123456} msg lappend mylist $msg +} -cleanup { testlinkarray remove ::my(var) + 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}} +test link-13.2 {linkarray short} -setup { + set mylist [list] +} -body { testlinkarray create short 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-13.3 {linkarray short} -body { testlinkarray create -r short 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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} +} -result {can't set "::my(var)": linked variable is read-only} test link-14.1 {linkarray unsigned short} -setup { set mylist [list] @@ -557,27 +566,30 @@ test link-14.1 {linkarray unsigned short} -setup { lappend mylist $msg catch {set ::my(var) -1} msg lappend mylist $msg +} -cleanup { testlinkarray remove ::my(var) + 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}} +test link-14.2 {linkarray unsigned short} -setup { + set mylist [list] +} -body { testlinkarray create ushort 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-14.3 {linkarray unsigned short} -body { testlinkarray create -r ushort 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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 -can't set "::my(var)": wrong dimension -1 2 3 4 -can't set "::my(var)": linked variable is read-only} +} -result {can't set "::my(var)": linked variable is read-only} test link-15.1 {linkarray int} -setup { set mylist [list] @@ -588,26 +600,30 @@ test link-15.1 {linkarray int} -setup { lappend mylist [set ::my(var) 120] catch {set ::my(var) 1e3} msg lappend mylist $msg +} -cleanup { testlinkarray remove ::my(var) + 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}} +test link-15.2 {linkarray int} -setup { + set mylist [list] +} -body { testlinkarray create int 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-15.3 {linkarray int} -body { testlinkarray create -r int 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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} +} -result {can't set "::my(var)": linked variable is read-only} test link-16.1 {linkarray unsigned int} -setup { set mylist [list] @@ -620,27 +636,30 @@ test link-16.1 {linkarray unsigned int} -setup { lappend mylist $msg catch {set ::my(var) -1} msg lappend mylist $msg +} -cleanup { testlinkarray remove ::my(var) + 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}} +test link-16.2 {linkarray unsigned int} -setup { + set mylist [list] +} -body { testlinkarray create uint 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain ::my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-16.3 {linkarray unsigned int} -body { testlinkarray create -r uint 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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 -can't set "::my(var)": wrong dimension -1 2 3 4 -can't set "::my(var)": linked variable is read-only} +} -result {can't set "::my(var)": linked variable is read-only} test link-17.1 {linkarray long} -setup { set mylist [list] @@ -651,60 +670,74 @@ test link-17.1 {linkarray long} -setup { lappend mylist [set ::my(var) 120] catch {set ::my(var) 1e33} msg lappend mylist $msg +} -match glob -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": variable must have * value} 120 {can't set "::my(var)": variable must have * value}} +test link-17.2 {linkarray long} -setup { + set mylist [list] +} -body { testlinkarray create long 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-17.3 {linkarray long} -body { testlinkarray create -r long 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) unset -nocomplain my -} -match glob -result {can't set "::my(var)": variable must have * value -120 -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} +} -result {can't set "::my(var)": linked variable is read-only} -test link-18.1 {linkarray unsigned long} -constraints knownBug -setup { +test link-18.1 {linkarray unsigned long} -setup { set mylist [list] } -body { - # Implementation needs to use bignums on 64-bit platforms testlinkarray create ulong 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg lappend mylist [set ::my(var) 120] catch {set ::my(var) 1e33} msg lappend mylist $msg +} -match glob -cleanup { + testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": variable must have unsigned * value} 120 {can't set "::my(var)": variable must have unsigned * value}} +test link-18.2 {linkarray unsigned long} -constraints knownBug -body { + # BUG: Implementation needs to use bignums on 64-bit platforms + testlinkarray create ulong 1 ::my(var) + set ::my(var) 120 catch {set ::my(var) -1} msg - lappend mylist $msg + return $msg +} -match glob -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {can't set "::my(var)": variable must have unsigned * value} +test link-18.3 {linkarray unsigned long} -setup { + set mylist [list] +} -body { testlinkarray create ulong 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-18.4 {linkarray unsigned long} -body { testlinkarray create -r ulong 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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 * 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} +} -result {can't set "::my(var)": linked variable is read-only} test link-19.1 {linkarray wide} -setup { set mylist [list] @@ -715,60 +748,76 @@ test link-19.1 {linkarray wide} -setup { lappend mylist [set ::my(var) 120] catch {set ::my(var) 1e33} msg lappend mylist $msg +} -cleanup { testlinkarray remove ::my(var) + 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}} +test link-19.2 {linkarray wide} -setup { + set mylist [list] +} -body { testlinkarray create wide 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-19.3 {linkarray wide} -body { testlinkarray create -r wide 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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} +} -result {can't set "::my(var)": linked variable is read-only} -test link-20.1 {linkarray unsigned wide} -constraints knownBug -setup { +test link-20.1 {linkarray unsigned wide} -setup { set mylist [list] } -body { - # Implementation needs to use bignums testlinkarray create uwide 1 ::my(var) catch {set ::my(var) x} msg lappend mylist $msg lappend mylist [set ::my(var) 120] catch {set ::my(var) 1e33} msg lappend mylist $msg +} -cleanup { + testlinkarray remove ::my(var) + 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}} +test link-20.2 {linkarray unsigned wide} -constraints knownBug -setup { + set mylist [list] +} -body { + # BUG: Implementation needs to use bignums + testlinkarray create uwide 1 ::my(var) + set ::my(var) 120 catch {set ::my(var) -1} msg - lappend mylist $msg + return $msg +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {can't set "::my(var)": variable must have unsigned wide int value} +test link-20.3 {linkarray unsigned wide} -setup { + set mylist [list] +} -body { testlinkarray create uwide 4 ::my(var) catch {set ::my(var) {1 2 3}} msg lappend mylist $msg set ::my(var) {1 2 3 4} lappend mylist $my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}} +test link-20.4 {linkarray unsigned wide} -body { testlinkarray create -r uwide 2 ::my(var) catch {set ::my(var) {1 2}} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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 -can't set "::my(var)": wrong dimension -1 2 3 4 -can't set "::my(var)": linked variable is read-only} +} -result {can't set "::my(var)": linked variable is read-only} test link-21.1 {linkarray string} -setup { set mylist [list] @@ -777,18 +826,18 @@ test link-21.1 {linkarray string} -setup { lappend mylist [set ::my(var) ""] lappend mylist [set ::my(var) "xyz"] lappend mylist $::my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{} xyz xyz} +test link-21.2 {linkarray string} -body { testlinkarray create -r string 4 ::my(var) catch {set ::my(var) x} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) unset -nocomplain my -} -result { -xyz -xyz -can't set "::my(var)": linked variable is read-only} +} -result {can't set "::my(var)": linked variable is read-only} test link-22.1 {linkarray binary} -setup { set mylist [list] @@ -798,7 +847,13 @@ test link-22.1 {linkarray binary} -setup { catch {set ::my(var) xy} msg lappend mylist $msg lappend mylist $::my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong size of binary value} x} +test link-22.2 {linkarray binary} -setup { + set mylist [list] +} -body { testlinkarray create binary 4 ::my(var) catch {set ::my(var) abc} msg lappend mylist $msg @@ -806,20 +861,18 @@ test link-22.1 {linkarray binary} -setup { lappend mylist $msg set ::my(var) abcd lappend mylist $::my(var) +} -cleanup { testlinkarray remove ::my(var) + unset -nocomplain my +} -result {{can't set "::my(var)": wrong size of binary value} {can't set "::my(var)": wrong size of binary value} abcd} +test link-22.3 {linkarray binary} -body { testlinkarray create -r binary 4 ::my(var) catch {set ::my(var) xyzv} msg - lappend mylist $msg - testlinkarray remove ::my(var) - join $mylist "\n" + return $msg } -cleanup { + testlinkarray remove ::my(var) 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 -abcd -can't set "::my(var)": linked variable is read-only} +} -result {can't set "::my(var)": linked variable is read-only} catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0} catch {testlink delete} |