diff options
Diffstat (limited to 'tests/link.test')
| -rw-r--r-- | tests/link.test | 417 |
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 |