summaryrefslogtreecommitdiffstats
path: root/tests/link.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/link.test')
-rw-r--r--tests/link.test762
1 files changed, 72 insertions, 690 deletions
diff --git a/tests/link.test b/tests/link.test
index d515e42..3b423ec 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -1,59 +1,41 @@
# Commands covered: none
#
-# This file contains a collection of tests for Tcl_LinkVar and related library
-# procedures. Sourcing this file into Tcl runs the tests and generates output
-# for errors. No output means no errors were found.
+# This file contains a collection of tests for Tcl_LinkVar and related
+# library procedures. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
#
-# Copyright © 1993 The Regents of the University of California.
-# Copyright © 1994 Sun Microsystems, Inc.
-# Copyright © 1998-1999 Scriptics Corporation.
+# Copyright (c) 1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
-# See the file "license.terms" for information on usage and redistribution of
-# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.5
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-::tcltest::loadTestedCommands
-catch [list package require -exact tcl::test [info patchlevel]]
-
testConstraint testlink [llength [info commands testlink]]
-testConstraint testlinkarray [llength [info commands testlinkarray]]
foreach i {int real bool string} {
- unset -nocomplain $i
+ catch {unset $i}
}
-
-test link-0.1 {leak test} {testlink} {
- interp create i
- load {} Tcltest i
- i eval {
- testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
- namespace delete ::
- }
- interp delete i
-} {}
-
-test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup {
+test link-1.1 {reading C variables from Tcl} {testlink} {
testlink delete
-} -body {
testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list $int $real $bool $string $wide
-} -result {43 1.23 1 NULL 12341234}
-test link-1.2 {reading C variables from Tcl} -constraints {testlink} -setup {
+} {43 1.23 1 NULL 12341234}
+test link-1.2 {reading C variables from Tcl} {testlink} {
testlink delete
-} -body {
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -3 2 0 "A long string with spaces" 43214321 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
list $int $real $bool $string $wide $int $real $bool $string $wide
-} -result {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
+} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
-test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup {
+test link-2.1 {writing C variables from Tcl} {testlink} {
testlink delete
-} -body {
testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
set int "0o0721"
@@ -69,146 +51,36 @@ test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup {
set long 34543
set ulong 567890
set float 1.0987654321
- set uwide 12345678901234567890
+ set uwide 357357357357
concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 12345678901234567890 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 12345678901234567890}
-test link-2.2 {writing bad values into variables} -setup {
+} {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}
+test link-2.2 {writing bad values into variables} {testlink} {
testlink delete
-} -constraints {testlink} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set int 09a} msg] $msg $int
-} -result {1 {can't set "int": variable must have integer value} 43}
-test link-2.3 {writing bad values into variables} -setup {
+} {1 {can't set "int": variable must have integer value} 43}
+test link-2.3 {writing bad values into variables} {testlink} {
testlink delete
-} -constraints {testlink} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set real 1.x3} msg] $msg $real
-} -result {1 {can't set "real": variable must have real value} 1.23}
-test link-2.4 {writing bad values into variables} -setup {
+} {1 {can't set "real": variable must have real value} 1.23}
+test link-2.4 {writing bad values into variables} {testlink} {
testlink delete
-} -constraints {testlink} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set bool gorp} msg] $msg $bool
-} -result {1 {can't set "bool": variable must have boolean value} 1}
-test link-2.5 {writing bad values into variables} -setup {
+} {1 {can't set "bool": variable must have boolean value} 1}
+test link-2.5 {writing bad values into variables} {testlink} {
testlink delete
-} -constraints {testlink} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
list [catch {set wide gorp} msg] $msg $bool
-} -result {1 {can't set "wide": variable must have wide integer value} 1}
-test link-2.6 {writing C variables from Tcl} -constraints {testlink} -setup {
- testlink delete
-} -body {
- testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
- testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
- set int "+"
- set real "+"
- set bool 1
- set string "+"
- set wide "+"
- set char "+"
- set uchar "+"
- set short "+"
- set ushort "+"
- set uint "+"
- set long "+"
- set ulong "+"
- set float "+"
- set uwide "+"
- concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} -result {1 1.0 1 + 1 1 1 1 1 1 1 1 1.0 1 | + + 1 + + + + + + + + + + +}
-test link-2.7 {writing C variables from Tcl} -constraints {testlink} -setup {
- testlink delete
-} -body {
- testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
- testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
- set int "-"
- set real "-"
- set bool 0
- set string "-"
- set wide "-"
- set char "-"
- set uchar "-"
- set short "-"
- set ushort "-"
- set uint "-"
- set long "-"
- set ulong "-"
- set float "-"
- set uwide "-"
- concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} -result {0 0.0 0 - 0 0 0 0 0 0 0 0 0.0 0 | - - 0 - - - - - - - - - - -}
-test link-2.8 {writing C variables from Tcl} -constraints {testlink} -setup {
- testlink delete
-} -body {
- testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
- testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
- set int "0x"
- set real "0b"
- set bool 0
- set string "0"
- set wide "0O"
- set char "0X"
- set uchar "0B"
- set short "0O"
- set ushort "0x"
- set uint "0b"
- set long "0o"
- set ulong "0X"
- set float "0B"
- set uwide "0O"
- concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} -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}
-test link-2.9 {writing C variables from Tcl} -constraints {testlink} -setup {
- testlink delete
-} -body {
- testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
- testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
- set int 0
- set real 5000e
- set bool 0
- set string 0
- set wide 0
- set char 0
- set uchar 0
- set short 0
- set ushort 0
- set uint 0
- set long 0
- set ulong 0
- set float -60.00e+
- set uwide 0
- concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} -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}
-test link-2.10 {writing C variables from Tcl} -constraints {testlink} -setup {
- testlink delete
-} -body {
- testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
- testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
- set int "0x"
- set real "0b"
- set bool 0
- set string "0"
- set wide "0D"
- set char "0X"
- set uchar "0B"
- set short "0D"
- set ushort "0x"
- set uint "0b"
- set long "0d"
- set ulong "0X"
- set float "0B"
- set uwide "0D"
- concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} -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}
+} {1 {can't set "wide": variable must have integer value} 1}
-test link-3.1 {read-only variables} -constraints {testlink} -setup {
+test link-3.1 {read-only variables} {testlink} {
testlink delete
-} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0
list [catch {set int 4} msg] $msg $int \
@@ -216,10 +88,9 @@ test link-3.1 {read-only variables} -constraints {testlink} -setup {
[catch {set bool no} msg] $msg $bool \
[catch {set string "new value"} msg] $msg $string \
[catch {set wide 12341234} msg] $msg $wide
-} -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}
-test link-3.2 {read-only variables} -constraints {testlink} -setup {
+} {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}
+test link-3.2 {read-only variables} {testlink} {
testlink delete
-} -body {
testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0
list [catch {set int 4} msg] $msg $int \
@@ -227,21 +98,19 @@ test link-3.2 {read-only variables} -constraints {testlink} -setup {
[catch {set bool no} msg] $msg $bool \
[catch {set string "new value"} msg] $msg $string\
[catch {set wide 12341234} msg] $msg $wide
-} -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}
+} {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}
-test link-4.1 {unsetting linked variables} -constraints {testlink} -setup {
+test link-4.1 {unsetting linked variables} {testlink} {
testlink delete
-} -body {
testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
unset int real bool string wide
list [catch {set int} msg] $msg [catch {set real} msg] $msg \
[catch {set bool} msg] $msg [catch {set string} msg] $msg \
[catch {set wide} msg] $msg
-} -result {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
-test link-4.2 {unsetting linked variables} -constraints {testlink} -setup {
+} {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
+test link-4.2 {unsetting linked variables} {testlink} {
testlink delete
-} -body {
testlink set -6 -2.1 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
unset int real bool string wide
@@ -251,11 +120,10 @@ test link-4.2 {unsetting linked variables} -constraints {testlink} -setup {
set string newValue
set wide 333555
lrange [testlink get] 0 4
-} -result {102 16.0 1 newValue 333555}
+} {102 16.0 1 newValue 333555}
-test link-5.1 {unlinking variables} -constraints {testlink} -setup {
+test link-5.1 {unlinking variables} {testlink} {
testlink delete
-} -body {
testlink set -6 -2.25 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink delete
set int xx1
@@ -273,108 +141,98 @@ test link-5.1 {unlinking variables} -constraints {testlink} -setup {
set float dskjfbjfd
set uwide isdfsngs
testlink get
-} -result {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
-test link-5.2 {unlinking variables} -constraints {testlink} -setup {
+} {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
+test link-5.2 {unlinking variables} {testlink} {
testlink delete
-} -body {
testlink set -6 -2.25 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink delete
testlink set 25 14.7 7 - 999999 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
list $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
-} -result {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
+} {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
-test link-6.1 {errors in setting up link} -setup {
+test link-6.1 {errors in setting up link} {testlink} {
testlink delete
- unset -nocomplain int
-} -constraints {testlink} -body {
+ catch {unset int}
set int(44) 1
- testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-} -cleanup {
- unset -nocomplain int
-} -returnCodes error -result {can't set "int": variable is array}
+ list [catch {testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1} msg] $msg
+} {1 {can't set "int": variable is array}}
+catch {unset int}
-test link-7.1 {access to linked variables via upvar} -setup {
- testlink delete
-} -constraints {testlink} -body {
+test link-7.1 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar int y
unset y
}
+ testlink delete
testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
testlink set 14 {} {} {} {} {} {} {} {} {} {} {} {} {}
x
list [catch {set int} msg] $msg
-} -result {0 14}
-test link-7.2 {access to linked variables via upvar} -setup {
- testlink delete
-} -constraints {testlink} -body {
+} {0 14}
+test link-7.2 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar int y
return [set y]
}
+ testlink delete
testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
testlink set 0 {} {} {} {} {} {} {} {} {} {} {} {} {}
set int
testlink set 23 {} {} {} {} {} {} {} {} {} {} {} {} {}
x
list [x] $int
-} -result {23 23}
-test link-7.3 {access to linked variables via upvar} -setup {
- testlink delete
-} -constraints {testlink} -body {
+} {23 23}
+test link-7.3 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar int y
set y 44
}
+ testlink delete
testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $int
-} -result {1 {can't set "y": linked variable is read-only} 11}
-test link-7.4 {access to linked variables via upvar} -setup {
- testlink delete
-} -constraints {testlink} -body {
+} {1 {can't set "y": linked variable is read-only} 11}
+test link-7.4 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar int y
set y abc
}
+ testlink delete
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $int
-} -result {1 {can't set "y": variable must have integer value} -4}
-test link-7.5 {access to linked variables via upvar} -setup {
- testlink delete
-} -constraints {testlink} -body {
+} {1 {can't set "y": variable must have integer value} -4}
+test link-7.5 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar real y
set y abc
}
+ testlink delete
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $real
-} -result {1 {can't set "y": variable must have real value} 16.75}
-test link-7.6 {access to linked variables via upvar} -setup {
- testlink delete
-} -constraints {testlink} -body {
+} {1 {can't set "y": variable must have real value} 16.75}
+test link-7.6 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar bool y
set y abc
}
+ testlink delete
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $bool
-} -result {1 {can't set "y": variable must have boolean value} 1}
-test link-7.7 {access to linked variables via upvar} -setup {
- testlink delete
-} -constraints {testlink} -body {
+} {1 {can't set "y": variable must have boolean value} 1}
+test link-7.7 {access to linked variables via upvar} {testlink} {
proc x {} {
upvar wide y
set y abc
}
+ testlink delete
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
list [catch x msg] $msg $wide
-} -result {1 {can't set "y": variable must have wide integer value} 778899}
+} {1 {can't set "y": variable must have integer value} 778899}
test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
proc x args {
@@ -384,11 +242,11 @@ test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
set x {}
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
- trace add var int write x
+ trace var int w x
testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
- trace remove variable int write x
- return $x
-} {{int {} write} 32 -2.0 0 xyzzy 995511}
+ trace vdelete int w x
+ set x
+} {{int {} w} 32 -2.0 0 xyzzy 995511}
test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
proc x args {
global x int real bool string wide
@@ -398,10 +256,10 @@ test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
testlink delete
- trace add var int write x
+ trace var int w x
testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
- trace remove variable int write x
- return $x
+ trace vdelete int w x
+ set x
} {}
test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
@@ -410,488 +268,12 @@ test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
} msg] $msg $int
} {0 {} 47}
-test link-9.1 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
- testlinkarray
-} -result {wrong # args: should be "testlinkarray option args"}
-test link-9.2 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
- testlinkarray x
-} -result {bad option "x": must be update, remove, or create}
-test link-9.3 {linkarray usage messages} -constraints testlinkarray -body {
- testlinkarray update
-} -result {}
-test link-9.4 {linkarray usage messages} -constraints testlinkarray -body {
- testlinkarray remove
-} -result {}
-test link-9.5 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
- testlinkarray create
-} -result {wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?"}
-test link-9.6 {linkarray usage messages} -returnCodes error -constraints testlinkarray -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 -constraints testlinkarray -body {
- testlinkarray create char* 0 my
-} -result {wrong array size given}
-
-test link-10.1 {linkarray char*} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create char* 1 ::my(var)
- 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*} -constraints testlinkarray -body {
- testlinkarray create char* 4 ::my(var)
- set ::my(var) x
- catch {set ::my(var) xyzz} 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*} -constraints testlinkarray -body {
- testlinkarray create -r char* 4 ::my(var)
- catch {set ::my(var) x} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-11.1 {linkarray char} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create char 1 ::my(var)
- catch {set ::my(var) x} msg
- lappend mylist $msg
- 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} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r char 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-12.1 {linkarray unsigned char} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create uchar 1 ::my(var)
- catch {set ::my(var) x} msg
- lappend mylist $msg
- lappend mylist [set ::my(var) 120]
- catch {set ::my(var) 1234} msg
- 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} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r uchar 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-13.1 {linkarray short} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create short 1 ::my(var)
- catch {set ::my(var) x} msg
- lappend mylist $msg
- 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} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r short 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-14.1 {linkarray unsigned short} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create ushort 1 ::my(var)
- catch {set ::my(var) x} msg
- lappend mylist $msg
- lappend mylist [set ::my(var) 120]
- catch {set ::my(var) 123456} msg
- 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} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r ushort 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-15.1 {linkarray int} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create int 1 ::my(var)
- catch {set ::my(var) x} msg
- lappend mylist $msg
- 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} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r int 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-16.1 {linkarray unsigned int} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create uint 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
- 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} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r uint 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-17.1 {linkarray long} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create long 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 * value} 120 {can't set "::my(var)": variable must have * value}}
-test link-17.2 {linkarray long} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r long 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-18.1 {linkarray unsigned long} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- 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 testlinkarray -body {
- testlinkarray create ulong 1 ::my(var)
- set ::my(var) 120
- catch {set ::my(var) -1} 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} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r ulong 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-19.1 {linkarray wide} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create wide 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 wide integer value} 120 {can't set "::my(var)": variable must have wide integer value}}
-test link-19.2 {linkarray wide} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r wide 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-20.1 {linkarray unsigned wide} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- 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
- lappend mylist [set ::my(var) 0xbabed00dbabed00d]
-} -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} 0xbabed00dbabed00d}
-test link-20.2 {linkarray unsigned wide} -constraints testlinkarray -body {
- testlinkarray create uwide 1 ::my(var)
- set ::my(var) 120
- catch {set ::my(var) -1} 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} -constraints testlinkarray -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} -constraints testlinkarray -body {
- testlinkarray create -r uwide 2 ::my(var)
- catch {set ::my(var) {1 2}} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-21.1 {linkarray string} -constraints testlinkarray -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)
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {{} xyz xyz}
-test link-21.2 {linkarray string} -constraints testlinkarray -body {
- testlinkarray create -r string 4 ::my(var)
- catch {set ::my(var) x} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -result {can't set "::my(var)": linked variable is read-only}
-
-test link-22.1 {linkarray binary} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create binary 1 ::my(var)
- set ::my(var) x
- 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} -constraints testlinkarray -setup {
- set mylist [list]
-} -body {
- testlinkarray create binary 4 ::my(var)
- 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)
-} -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} -constraints testlinkarray -body {
- testlinkarray create -r binary 4 ::my(var)
- catch {set ::my(var) xyzv} msg
- return $msg
-} -cleanup {
- testlinkarray remove ::my(var)
- unset -nocomplain my
-} -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}
foreach i {int real bool string wide} {
- unset -nocomplain $i
+ catch {unset $i}
}
# cleanup
::tcltest::cleanupTests
return
-
-# Local Variables:
-# mode: tcl
-# fill-column: 78
-# End:
generated by cgit v0.12 at 2025-12-20 11:30:51 (GMT)