1# Commands covered:  none
2#
3# This file contains a collection of tests for Tcl_LinkVar and related library
4# procedures. Sourcing this file into Tcl runs the tests and generates output
5# for errors. No output means no errors were found.
6#
7# Copyright © 1993 The Regents of the University of California.
8# Copyright © 1994 Sun Microsystems, Inc.
9# Copyright © 1998-1999 Scriptics Corporation.
10#
11# See the file "license.terms" for information on usage and redistribution of
12# this file, and for a DISCLAIMER OF ALL WARRANTIES.
13
14if {"::tcltest" ni [namespace children]} {
15    package require tcltest 2.5
16    namespace import -force ::tcltest::*
17}
18
19::tcltest::loadTestedCommands
20catch [list package require -exact tcl::test [info patchlevel]]
21
22testConstraint testlink [llength [info commands testlink]]
23testConstraint testlinkarray [llength [info commands testlinkarray]]
24
25foreach i {int real bool string} {
26    unset -nocomplain $i
27}
28
29test link-0.1 {leak test} {testlink} {
30    interp create i
31    load {} Tcltest i
32    i eval {
33	testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
34	namespace delete ::
35    }
36    interp delete i
37} {}
38
39test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup {
40    testlink delete
41} -body {
42    testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
43    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
44    list $int $real $bool $string $wide
45} -result {43 1.23 1 NULL 12341234}
46test link-1.2 {reading C variables from Tcl} -constraints {testlink} -setup {
47    testlink delete
48} -body {
49    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
50    testlink set -3 2 0 "A long string with spaces"  43214321 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
51    list $int $real $bool $string $wide $int $real $bool $string $wide
52} -result {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
53
54test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup {
55    testlink delete
56} -body {
57    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
58    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
59    set int "0o0721"
60    set real -10.5
61    set bool true
62    set string abcdef
63    set wide 135135
64    set char 79
65    set uchar 161
66    set short 8000
67    set ushort 40000
68    set uint 0xc001babe
69    set long 34543
70    set ulong 567890
71    set float 1.0987654321
72    set uwide 357357357357
73    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
74} -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}
75test link-2.2 {writing bad values into variables} -setup {
76    testlink delete
77} -constraints {testlink} -body {
78    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
79    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
80    list [catch {set int 09a} msg] $msg $int
81} -result {1 {can't set "int": variable must have integer value} 43}
82test link-2.3 {writing bad values into variables} -setup {
83    testlink delete
84} -constraints {testlink} -body {
85    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
86    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
87    list [catch {set real 1.x3} msg] $msg $real
88} -result {1 {can't set "real": variable must have real value} 1.23}
89test link-2.4 {writing bad values into variables} -setup {
90    testlink delete
91} -constraints {testlink} -body {
92    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
93    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
94    list [catch {set bool gorp} msg] $msg $bool
95} -result {1 {can't set "bool": variable must have boolean value} 1}
96test link-2.5 {writing bad values into variables} -setup {
97    testlink delete
98} -constraints {testlink} -body {
99    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
100    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
101    list [catch {set wide gorp} msg] $msg $bool
102} -result {1 {can't set "wide": variable must have wide integer value} 1}
103test link-2.6 {writing C variables from Tcl} -constraints {testlink} -setup {
104    testlink delete
105} -body {
106    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
107    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
108    set int "+"
109    set real "+"
110    set bool 1
111    set string "+"
112    set wide "+"
113    set char "+"
114    set uchar "+"
115    set short "+"
116    set ushort "+"
117    set uint "+"
118    set long "+"
119    set ulong "+"
120    set float "+"
121    set uwide "+"
122    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
123} -result {1 1.0 1 + 1 1 1 1 1 1 1 1 1.0 1 | + + 1 + + + + + + + + + + +}
124test link-2.7 {writing C variables from Tcl} -constraints {testlink} -setup {
125    testlink delete
126} -body {
127    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
128    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
129    set int "-"
130    set real "-"
131    set bool 0
132    set string "-"
133    set wide "-"
134    set char "-"
135    set uchar "-"
136    set short "-"
137    set ushort "-"
138    set uint "-"
139    set long "-"
140    set ulong "-"
141    set float "-"
142    set uwide "-"
143    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
144} -result {0 0.0 0 - 0 0 0 0 0 0 0 0 0.0 0 | - - 0 - - - - - - - - - - -}
145test link-2.8 {writing C variables from Tcl} -constraints {testlink} -setup {
146    testlink delete
147} -body {
148    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
149    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
150    set int "0x"
151    set real "0b"
152    set bool 0
153    set string "0"
154    set wide "0O"
155    set char "0X"
156    set uchar "0B"
157    set short "0O"
158    set ushort "0x"
159    set uint "0b"
160    set long "0o"
161    set ulong "0X"
162    set float "0B"
163    set uwide "0O"
164    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
165} -result {0 0.0 0 0 0 0 0 0 0 0 0 0 0.0 0 | 0x 0b 0 0 0O 0X 0B 0O 0x 0b 0o 0X 0B 0O}
166test link-2.9 {writing C variables from Tcl} -constraints {testlink} -setup {
167    testlink delete
168} -body {
169    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
170    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
171    set int 0
172    set real 5000e
173    set bool 0
174    set string 0
175    set wide 0
176    set char 0
177    set uchar 0
178    set short 0
179    set ushort 0
180    set uint 0
181    set long 0
182    set ulong 0
183    set float -60.00e+
184    set uwide 0
185    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
186} -result {0 5000.0 0 0 0 0 0 0 0 0 0 0 -60.0 0 | 0 5000e 0 0 0 0 0 0 0 0 0 0 -60.00e+ 0}
187test link-2.10 {writing C variables from Tcl} -constraints {testlink} -setup {
188    testlink delete
189} -body {
190    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
191    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
192    set int "0x"
193    set real "0b"
194    set bool 0
195    set string "0"
196    set wide "0D"
197    set char "0X"
198    set uchar "0B"
199    set short "0D"
200    set ushort "0x"
201    set uint "0b"
202    set long "0d"
203    set ulong "0X"
204    set float "0B"
205    set uwide "0D"
206    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
207} -result {0 0.0 0 0 0 0 0 0 0 0 0 0 0.0 0 | 0x 0b 0 0 0D 0X 0B 0D 0x 0b 0d 0X 0B 0D}
208
209test link-3.1 {read-only variables} -constraints {testlink} -setup {
210    testlink delete
211} -body {
212    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
213    testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0
214    list [catch {set int 4} msg] $msg $int \
215	[catch {set real 10.6} msg] $msg $real \
216	[catch {set bool no} msg] $msg $bool \
217	[catch {set string "new value"} msg] $msg $string \
218	[catch {set wide 12341234} msg] $msg $wide
219} -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}
220test link-3.2 {read-only variables} -constraints {testlink} -setup {
221    testlink delete
222} -body {
223    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
224    testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0
225    list [catch {set int 4} msg] $msg $int \
226	[catch {set real 10.6} msg] $msg $real \
227	[catch {set bool no} msg] $msg $bool \
228	[catch {set string "new value"} msg] $msg $string\
229	[catch {set wide 12341234} msg] $msg $wide
230} -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}
231
232test link-4.1 {unsetting linked variables} -constraints {testlink} -setup {
233    testlink delete
234} -body {
235    testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
236    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
237    unset int real bool string wide
238    list [catch {set int} msg] $msg [catch {set real} msg] $msg \
239	    [catch {set bool} msg] $msg [catch {set string} msg] $msg \
240	    [catch {set wide} msg] $msg
241} -result {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
242test link-4.2 {unsetting linked variables} -constraints {testlink} -setup {
243    testlink delete
244} -body {
245    testlink set -6 -2.1 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
246    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
247    unset int real bool string wide
248    set int 102
249    set real 16
250    set bool true
251    set string newValue
252    set wide 333555
253    lrange [testlink get] 0 4
254} -result {102 16.0 1 newValue 333555}
255
256test link-5.1 {unlinking variables} -constraints {testlink} -setup {
257    testlink delete
258} -body {
259    testlink set -6 -2.25 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
260    testlink delete
261    set int xx1
262    set real qrst
263    set bool bogus
264    set string 12345
265    set wide 875421
266    set char skjdf
267    set uchar dslfjk
268    set short slkf
269    set ushort skrh
270    set uint sfdkfkh
271    set long srkjh
272    set ulong sjkg
273    set float dskjfbjfd
274    set uwide isdfsngs
275    testlink get
276} -result {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
277test link-5.2 {unlinking variables} -constraints {testlink} -setup {
278    testlink delete
279} -body {
280    testlink set -6 -2.25 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
281    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
282    testlink delete
283    testlink set 25 14.7 7 - 999999 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
284    list $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
285} -result {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
286
287test link-6.1 {errors in setting up link} -setup {
288    testlink delete
289    unset -nocomplain int
290} -constraints {testlink} -body {
291    set int(44) 1
292    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
293} -cleanup {
294    unset -nocomplain int
295} -returnCodes error -result {can't set "int": variable is array}
296
297test link-7.1 {access to linked variables via upvar} -setup {
298    testlink delete
299} -constraints {testlink} -body {
300    proc x {} {
301	upvar int y
302	unset y
303    }
304    testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
305    testlink set 14 {} {} {} {} {} {} {} {} {} {} {} {} {}
306    x
307    list [catch {set int} msg] $msg
308} -result {0 14}
309test link-7.2 {access to linked variables via upvar} -setup {
310    testlink delete
311} -constraints {testlink} -body {
312    proc x {} {
313	upvar int y
314	return [set y]
315    }
316    testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
317    testlink set 0 {} {} {} {} {} {} {} {} {} {} {} {} {}
318    set int
319    testlink set 23 {} {} {} {} {} {} {} {} {} {} {} {} {}
320    x
321    list [x] $int
322} -result {23 23}
323test link-7.3 {access to linked variables via upvar} -setup {
324    testlink delete
325} -constraints {testlink} -body {
326    proc x {} {
327	upvar int y
328	set y 44
329    }
330    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
331    testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {}
332    list [catch x msg] $msg $int
333} -result {1 {can't set "y": linked variable is read-only} 11}
334test link-7.4 {access to linked variables via upvar} -setup {
335    testlink delete
336} -constraints {testlink} -body {
337    proc x {} {
338	upvar int y
339	set y abc
340    }
341    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
342    testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {}
343    list [catch x msg] $msg $int
344} -result {1 {can't set "y": variable must have integer value} -4}
345test link-7.5 {access to linked variables via upvar} -setup {
346    testlink delete
347} -constraints {testlink} -body {
348    proc x {} {
349	upvar real y
350	set y abc
351    }
352    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
353    testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {}
354    list [catch x msg] $msg $real
355} -result {1 {can't set "y": variable must have real value} 16.75}
356test link-7.6 {access to linked variables via upvar} -setup {
357    testlink delete
358} -constraints {testlink} -body {
359    proc x {} {
360	upvar bool y
361	set y abc
362    }
363    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
364    testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {}
365    list [catch x msg] $msg $bool
366} -result {1 {can't set "y": variable must have boolean value} 1}
367test link-7.7 {access to linked variables via upvar} -setup {
368    testlink delete
369} -constraints {testlink} -body {
370    proc x {} {
371	upvar wide y
372	set y abc
373    }
374    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
375    testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
376    list [catch x msg] $msg $wide
377} -result {1 {can't set "y": variable must have wide integer value} 778899}
378
379test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
380    proc x args {
381	global x int real bool string wide
382	lappend x $args $int $real $bool $string $wide
383    }
384    set x {}
385    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
386    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
387    trace var int w x
388    testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
389    trace vdelete int w x
390    return $x
391} {{int {} w} 32 -2.0 0 xyzzy 995511}
392test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
393    proc x args {
394	global x int real bool string wide
395	lappend x $args $int $real $bool $string $wide
396    }
397    set x {}
398    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
399    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
400    testlink delete
401    trace var int w x
402    testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
403    trace vdelete int w x
404    return $x
405} {}
406test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
407    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
408    list [catch {
409	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
410    } msg] $msg $int
411} {0 {} 47}
412
413test link-9.1 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
414    testlinkarray
415} -result {wrong # args: should be "testlinkarray option args"}
416test link-9.2 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
417    testlinkarray x
418} -result {bad option "x": must be update, remove, or create}
419test link-9.3 {linkarray usage messages} -constraints testlinkarray -body {
420    testlinkarray update
421} -result {}
422test link-9.4 {linkarray usage messages} -constraints testlinkarray -body {
423    testlinkarray remove
424} -result {}
425test link-9.5 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
426    testlinkarray create
427} -result {wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?"}
428test link-9.6 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
429    testlinkarray create xx 1 my
430} -result {bad type "xx": must be char, uchar, short, ushort, int, uint, long, ulong, wide, uwide, float, double, string, char*, or binary}
431test link-9.7 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
432    testlinkarray create char* 0 my
433} -result {wrong array size given}
434
435test link-10.1 {linkarray char*} -constraints testlinkarray -setup {
436    set mylist [list]
437} -body {
438    testlinkarray create char* 1 ::my(var)
439    lappend mylist [set ::my(var) ""]
440    catch {set ::my(var) x} msg
441    lappend mylist $msg
442} -cleanup {
443    testlinkarray remove ::my(var)
444    unset -nocomplain my
445} -result {{} {can't set "::my(var)": wrong size of char* value}}
446test link-10.2 {linkarray char*} -constraints testlinkarray -body {
447    testlinkarray create char* 4 ::my(var)
448    set ::my(var) x
449    catch {set ::my(var) xyzz} msg
450    return $msg
451} -cleanup {
452    testlinkarray remove ::my(var)
453    unset -nocomplain my
454} -result {can't set "::my(var)": wrong size of char* value}
455test link-10.3 {linkarray char*} -constraints testlinkarray -body {
456    testlinkarray create -r char* 4 ::my(var)
457    catch {set ::my(var) x} msg
458    return $msg
459} -cleanup {
460    testlinkarray remove ::my(var)
461    unset -nocomplain my
462} -result {can't set "::my(var)": linked variable is read-only}
463
464test link-11.1 {linkarray char} -constraints testlinkarray -setup {
465    set mylist [list]
466} -body {
467    testlinkarray create char 1 ::my(var)
468    catch {set ::my(var) x} msg
469    lappend mylist $msg
470    lappend mylist [set ::my(var) 120]
471    catch {set ::my(var) 1234} msg
472    lappend mylist $msg
473} -cleanup {
474    testlinkarray remove ::my(var)
475    unset -nocomplain my
476} -result {{can't set "::my(var)": variable must have char value} 120 {can't set "::my(var)": variable must have char value}}
477test link-11.2 {linkarray char} -constraints testlinkarray -setup {
478    set mylist [list]
479} -body {
480    testlinkarray create char 4 ::my(var)
481    catch {set ::my(var) {1 2 3}} msg
482    lappend mylist $msg
483    set ::my(var) {1 2 3 4}
484    lappend mylist $my(var)
485} -cleanup {
486    testlinkarray remove ::my(var)
487    unset -nocomplain my
488} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
489test link-11.3 {linkarray char} -constraints testlinkarray -body {
490    testlinkarray create -r char 2 ::my(var)
491    catch {set ::my(var) {1 2}} msg
492    return $msg
493} -cleanup {
494    testlinkarray remove ::my(var)
495    unset -nocomplain my
496} -result {can't set "::my(var)": linked variable is read-only}
497
498test link-12.1 {linkarray unsigned char} -constraints testlinkarray -setup {
499    set mylist [list]
500} -body {
501    testlinkarray create uchar 1 ::my(var)
502    catch {set ::my(var) x} msg
503    lappend mylist $msg
504    lappend mylist [set ::my(var) 120]
505    catch {set ::my(var) 1234} msg
506    lappend mylist $msg
507    catch {set ::my(var) -1} msg
508    lappend mylist $msg
509} -cleanup {
510    testlinkarray remove ::my(var)
511    unset -nocomplain my
512} -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}}
513test link-12.2 {linkarray unsigned char} -constraints testlinkarray -setup {
514    set mylist [list]
515} -body {
516    testlinkarray create uchar 4 ::my(var)
517    catch {set ::my(var) {1 2 3}} msg
518    lappend mylist $msg
519    set ::my(var) {1 2 3 4}
520    lappend mylist $my(var)
521} -cleanup {
522    testlinkarray remove ::my(var)
523    unset -nocomplain my
524} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
525test link-12.3 {linkarray unsigned char} -constraints testlinkarray -body {
526    testlinkarray create -r uchar 2 ::my(var)
527    catch {set ::my(var) {1 2}} msg
528    return $msg
529} -cleanup {
530    testlinkarray remove ::my(var)
531    unset -nocomplain my
532} -result {can't set "::my(var)": linked variable is read-only}
533
534test link-13.1 {linkarray short} -constraints testlinkarray -setup {
535    set mylist [list]
536} -body {
537    testlinkarray create short 1 ::my(var)
538    catch {set ::my(var) x} msg
539    lappend mylist $msg
540    lappend mylist [set ::my(var) 120]
541    catch {set ::my(var) 123456} msg
542    lappend mylist $msg
543} -cleanup {
544    testlinkarray remove ::my(var)
545    unset -nocomplain my
546} -result {{can't set "::my(var)": variable must have short value} 120 {can't set "::my(var)": variable must have short value}}
547test link-13.2 {linkarray short} -constraints testlinkarray -setup {
548    set mylist [list]
549} -body {
550    testlinkarray create short 4 ::my(var)
551    catch {set ::my(var) {1 2 3}} msg
552    lappend mylist $msg
553    set ::my(var) {1 2 3 4}
554    lappend mylist $my(var)
555} -cleanup {
556    testlinkarray remove ::my(var)
557    unset -nocomplain my
558} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
559test link-13.3 {linkarray short} -constraints testlinkarray -body {
560    testlinkarray create -r short 2 ::my(var)
561    catch {set ::my(var) {1 2}} msg
562    return $msg
563} -cleanup {
564    testlinkarray remove ::my(var)
565    unset -nocomplain my
566} -result {can't set "::my(var)": linked variable is read-only}
567
568test link-14.1 {linkarray unsigned short} -constraints testlinkarray -setup {
569    set mylist [list]
570} -body {
571    testlinkarray create ushort 1 ::my(var)
572    catch {set ::my(var) x} msg
573    lappend mylist $msg
574    lappend mylist [set ::my(var) 120]
575    catch {set ::my(var) 123456} msg
576    lappend mylist $msg
577    catch {set ::my(var) -1} msg
578    lappend mylist $msg
579} -cleanup {
580    testlinkarray remove ::my(var)
581    unset -nocomplain my
582} -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}}
583test link-14.2 {linkarray unsigned short} -constraints testlinkarray -setup {
584    set mylist [list]
585} -body {
586    testlinkarray create ushort 4 ::my(var)
587    catch {set ::my(var) {1 2 3}} msg
588    lappend mylist $msg
589    set ::my(var) {1 2 3 4}
590    lappend mylist $my(var)
591} -cleanup {
592    testlinkarray remove ::my(var)
593    unset -nocomplain my
594} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
595test link-14.3 {linkarray unsigned short} -constraints testlinkarray -body {
596    testlinkarray create -r ushort 2 ::my(var)
597    catch {set ::my(var) {1 2}} msg
598    return $msg
599} -cleanup {
600    testlinkarray remove ::my(var)
601    unset -nocomplain my
602} -result {can't set "::my(var)": linked variable is read-only}
603
604test link-15.1 {linkarray int} -constraints testlinkarray -setup {
605    set mylist [list]
606} -body {
607    testlinkarray create int 1 ::my(var)
608    catch {set ::my(var) x} msg
609    lappend mylist $msg
610    lappend mylist [set ::my(var) 120]
611    catch {set ::my(var) 1e3} msg
612    lappend mylist $msg
613} -cleanup {
614    testlinkarray remove ::my(var)
615    unset -nocomplain my
616} -result {{can't set "::my(var)": variable must have integer value} 120 {can't set "::my(var)": variable must have integer value}}
617test link-15.2 {linkarray int} -constraints testlinkarray -setup {
618    set mylist [list]
619} -body {
620    testlinkarray create int 4 ::my(var)
621    catch {set ::my(var) {1 2 3}} msg
622    lappend mylist $msg
623    set ::my(var) {1 2 3 4}
624    lappend mylist $my(var)
625} -cleanup {
626    testlinkarray remove ::my(var)
627    unset -nocomplain my
628} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
629test link-15.3 {linkarray int} -constraints testlinkarray -body {
630    testlinkarray create -r int 2 ::my(var)
631    catch {set ::my(var) {1 2}} msg
632    return $msg
633} -cleanup {
634    testlinkarray remove ::my(var)
635    unset -nocomplain my
636} -result {can't set "::my(var)": linked variable is read-only}
637
638test link-16.1 {linkarray unsigned int} -constraints testlinkarray -setup {
639    set mylist [list]
640} -body {
641    testlinkarray create uint 1 ::my(var)
642    catch {set ::my(var) x} msg
643    lappend mylist $msg
644    lappend mylist [set ::my(var) 120]
645    catch {set ::my(var) 1e33} msg
646    lappend mylist $msg
647    catch {set ::my(var) -1} msg
648    lappend mylist $msg
649} -cleanup {
650    testlinkarray remove ::my(var)
651    unset -nocomplain ::my
652} -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}}
653test link-16.2 {linkarray unsigned int} -constraints testlinkarray -setup {
654    set mylist [list]
655} -body {
656    testlinkarray create uint 4 ::my(var)
657    catch {set ::my(var) {1 2 3}} msg
658    lappend mylist $msg
659    set ::my(var) {1 2 3 4}
660    lappend mylist $my(var)
661} -cleanup {
662    testlinkarray remove ::my(var)
663    unset -nocomplain ::my
664} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
665test link-16.3 {linkarray unsigned int} -constraints testlinkarray -body {
666    testlinkarray create -r uint 2 ::my(var)
667    catch {set ::my(var) {1 2}} msg
668    return $msg
669} -cleanup {
670    testlinkarray remove ::my(var)
671    unset -nocomplain my
672} -result {can't set "::my(var)": linked variable is read-only}
673
674test link-17.1 {linkarray long} -constraints testlinkarray -setup {
675    set mylist [list]
676} -body {
677    testlinkarray create long 1 ::my(var)
678    catch {set ::my(var) x} msg
679    lappend mylist $msg
680    lappend mylist [set ::my(var) 120]
681    catch {set ::my(var) 1e33} msg
682    lappend mylist $msg
683} -match glob -cleanup {
684    testlinkarray remove ::my(var)
685    unset -nocomplain my
686} -result {{can't set "::my(var)": variable must have * value} 120 {can't set "::my(var)": variable must have * value}}
687test link-17.2 {linkarray long} -constraints testlinkarray -setup {
688    set mylist [list]
689} -body {
690    testlinkarray create long 4 ::my(var)
691    catch {set ::my(var) {1 2 3}} msg
692    lappend mylist $msg
693    set ::my(var) {1 2 3 4}
694    lappend mylist $my(var)
695} -cleanup {
696    testlinkarray remove ::my(var)
697    unset -nocomplain my
698} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
699test link-17.3 {linkarray long} -constraints testlinkarray -body {
700    testlinkarray create -r long 2 ::my(var)
701    catch {set ::my(var) {1 2}} msg
702    return $msg
703} -cleanup {
704    testlinkarray remove ::my(var)
705    unset -nocomplain my
706} -result {can't set "::my(var)": linked variable is read-only}
707
708test link-18.1 {linkarray unsigned long} -constraints testlinkarray -setup {
709    set mylist [list]
710} -body {
711    testlinkarray create ulong 1 ::my(var)
712    catch {set ::my(var) x} msg
713    lappend mylist $msg
714    lappend mylist [set ::my(var) 120]
715    catch {set ::my(var) 1e33} msg
716    lappend mylist $msg
717} -match glob -cleanup {
718    testlinkarray remove ::my(var)
719    unset -nocomplain my
720} -result {{can't set "::my(var)": variable must have unsigned * value} 120 {can't set "::my(var)": variable must have unsigned * value}}
721test link-18.2 {linkarray unsigned long} -constraints testlinkarray -body {
722    testlinkarray create ulong 1 ::my(var)
723    set ::my(var) 120
724    catch {set ::my(var) -1} msg
725    return $msg
726} -match glob -cleanup {
727    testlinkarray remove ::my(var)
728    unset -nocomplain my
729} -result {can't set "::my(var)": variable must have unsigned * value}
730test link-18.3 {linkarray unsigned long} -constraints testlinkarray -setup {
731    set mylist [list]
732} -body {
733    testlinkarray create ulong 4 ::my(var)
734    catch {set ::my(var) {1 2 3}} msg
735    lappend mylist $msg
736    set ::my(var) {1 2 3 4}
737    lappend mylist $my(var)
738} -cleanup {
739    testlinkarray remove ::my(var)
740    unset -nocomplain my
741} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
742test link-18.4 {linkarray unsigned long} -constraints testlinkarray -body {
743    testlinkarray create -r ulong 2 ::my(var)
744    catch {set ::my(var) {1 2}} msg
745    return $msg
746} -cleanup {
747    testlinkarray remove ::my(var)
748    unset -nocomplain my
749} -result {can't set "::my(var)": linked variable is read-only}
750
751test link-19.1 {linkarray wide} -constraints testlinkarray -setup {
752    set mylist [list]
753} -body {
754    testlinkarray create wide 1 ::my(var)
755    catch {set ::my(var) x} msg
756    lappend mylist $msg
757    lappend mylist [set ::my(var) 120]
758    catch {set ::my(var) 1e33} msg
759    lappend mylist $msg
760} -cleanup {
761    testlinkarray remove ::my(var)
762    unset -nocomplain my
763} -result {{can't set "::my(var)": variable must have wide integer value} 120 {can't set "::my(var)": variable must have wide integer value}}
764test link-19.2 {linkarray wide} -constraints testlinkarray -setup {
765    set mylist [list]
766} -body {
767    testlinkarray create wide 4 ::my(var)
768    catch {set ::my(var) {1 2 3}} msg
769    lappend mylist $msg
770    set ::my(var) {1 2 3 4}
771    lappend mylist $my(var)
772} -cleanup {
773    testlinkarray remove ::my(var)
774    unset -nocomplain my
775} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
776test link-19.3 {linkarray wide} -constraints testlinkarray -body {
777    testlinkarray create -r wide 2 ::my(var)
778    catch {set ::my(var) {1 2}} msg
779    return $msg
780} -cleanup {
781    testlinkarray remove ::my(var)
782    unset -nocomplain my
783} -result {can't set "::my(var)": linked variable is read-only}
784
785test link-20.1 {linkarray unsigned wide} -constraints testlinkarray -setup {
786    set mylist [list]
787} -body {
788    testlinkarray create uwide 1 ::my(var)
789    catch {set ::my(var) x} msg
790    lappend mylist $msg
791    lappend mylist [set ::my(var) 120]
792    catch {set ::my(var) 1e33} msg
793    lappend mylist $msg
794    lappend mylist [set ::my(var) 0xbabed00dbabed00d]
795} -cleanup {
796    testlinkarray remove ::my(var)
797    unset -nocomplain my
798} -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} 0xbabed00dbabed00d}
799test link-20.2 {linkarray unsigned wide} -constraints testlinkarray -body {
800    testlinkarray create uwide 1 ::my(var)
801    set ::my(var) 120
802    catch {set ::my(var) -1} msg
803    return $msg
804} -cleanup {
805    testlinkarray remove ::my(var)
806    unset -nocomplain my
807} -result {can't set "::my(var)": variable must have unsigned wide int value}
808test link-20.3 {linkarray unsigned wide} -constraints testlinkarray -setup {
809    set mylist [list]
810} -body {
811    testlinkarray create uwide 4 ::my(var)
812    catch {set ::my(var) {1 2 3}} msg
813    lappend mylist $msg
814    set ::my(var) {1 2 3 4}
815    lappend mylist $my(var)
816} -cleanup {
817    testlinkarray remove ::my(var)
818    unset -nocomplain my
819} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
820test link-20.4 {linkarray unsigned wide} -constraints testlinkarray -body {
821    testlinkarray create -r uwide 2 ::my(var)
822    catch {set ::my(var) {1 2}} msg
823    return $msg
824} -cleanup {
825    testlinkarray remove ::my(var)
826    unset -nocomplain my
827} -result {can't set "::my(var)": linked variable is read-only}
828
829test link-21.1 {linkarray string} -constraints testlinkarray -setup {
830    set mylist [list]
831} -body {
832    testlinkarray create string 1 ::my(var)
833    lappend mylist [set ::my(var) ""]
834    lappend mylist [set ::my(var) "xyz"]
835    lappend mylist $::my(var)
836} -cleanup {
837    testlinkarray remove ::my(var)
838    unset -nocomplain my
839} -result {{} xyz xyz}
840test link-21.2 {linkarray string} -constraints testlinkarray -body {
841    testlinkarray create -r string 4 ::my(var)
842    catch {set ::my(var) x} msg
843    return $msg
844} -cleanup {
845    testlinkarray remove ::my(var)
846    unset -nocomplain my
847} -result {can't set "::my(var)": linked variable is read-only}
848
849test link-22.1 {linkarray binary} -constraints testlinkarray -setup {
850    set mylist [list]
851} -body {
852    testlinkarray create binary 1 ::my(var)
853    set ::my(var) x
854    catch {set ::my(var) xy} msg
855    lappend mylist $msg
856    lappend mylist $::my(var)
857} -cleanup {
858    testlinkarray remove ::my(var)
859    unset -nocomplain my
860} -result {{can't set "::my(var)": wrong size of binary value} x}
861test link-22.2 {linkarray binary} -constraints testlinkarray -setup {
862    set mylist [list]
863} -body {
864    testlinkarray create binary 4 ::my(var)
865    catch {set ::my(var) abc} msg
866    lappend mylist $msg
867    catch {set ::my(var) abcde} msg
868    lappend mylist $msg
869    set ::my(var) abcd
870    lappend mylist $::my(var)
871} -cleanup {
872    testlinkarray remove ::my(var)
873    unset -nocomplain my
874} -result {{can't set "::my(var)": wrong size of binary value} {can't set "::my(var)": wrong size of binary value} abcd}
875test link-22.3 {linkarray binary} -constraints testlinkarray -body {
876    testlinkarray create -r binary 4 ::my(var)
877    catch {set ::my(var) xyzv} msg
878    return $msg
879} -cleanup {
880    testlinkarray remove ::my(var)
881    unset -nocomplain my
882} -result {can't set "::my(var)": linked variable is read-only}
883
884catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0}
885catch {testlink delete}
886foreach i {int real bool string wide} {
887    unset -nocomplain $i
888}
889
890# cleanup
891::tcltest::cleanupTests
892return
893
894# Local Variables:
895# mode: tcl
896# fill-column: 78
897# End:
898