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