os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/link.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/link.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,262 @@
1.4 +# Commands covered: none
1.5 +#
1.6 +# This file contains a collection of tests for Tcl_LinkVar and related
1.7 +# library procedures. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: link.test,v 1.7 2002/06/22 04:19:47 dgp Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest 2
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +::tcltest::testConstraint testlink \
1.25 + [expr {[info commands testlink] != {}}]
1.26 +
1.27 +foreach i {int real bool string} {
1.28 + catch {unset $i}
1.29 +}
1.30 +test link-1.1 {reading C variables from Tcl} {testlink} {
1.31 + testlink delete
1.32 + testlink set 43 1.23 4 - 12341234
1.33 + testlink create 1 1 1 1 1
1.34 + list $int $real $bool $string $wide
1.35 +} {43 1.23 1 NULL 12341234}
1.36 +test link-1.2 {reading C variables from Tcl} {testlink} {
1.37 + testlink delete
1.38 + testlink create 1 1 1 1 1
1.39 + testlink set -3 2 0 "A long string with spaces" 43214321
1.40 + list $int $real $bool $string $wide $int $real $bool $string $wide
1.41 +} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
1.42 +
1.43 +test link-2.1 {writing C variables from Tcl} {testlink} {
1.44 + testlink delete
1.45 + testlink set 43 1.21 4 - 56785678
1.46 + testlink create 1 1 1 1 1
1.47 + set int "00721"
1.48 + set real -10.5
1.49 + set bool true
1.50 + set string abcdef
1.51 + set wide 135135
1.52 + concat [testlink get] $int $real $bool $string $wide
1.53 +} {465 -10.5 1 abcdef 135135 00721 -10.5 true abcdef 135135}
1.54 +test link-2.2 {writing bad values into variables} {testlink} {
1.55 + testlink delete
1.56 + testlink set 43 1.23 4 - 56785678
1.57 + testlink create 1 1 1 1 1
1.58 + list [catch {set int 09a} msg] $msg $int
1.59 +} {1 {can't set "int": variable must have integer value} 43}
1.60 +test link-2.3 {writing bad values into variables} {testlink} {
1.61 + testlink delete
1.62 + testlink set 43 1.23 4 - 56785678
1.63 + testlink create 1 1 1 1 1
1.64 + list [catch {set real 1.x3} msg] $msg $real
1.65 +} {1 {can't set "real": variable must have real value} 1.23}
1.66 +test link-2.4 {writing bad values into variables} {testlink} {
1.67 + testlink delete
1.68 + testlink set 43 1.23 4 - 56785678
1.69 + testlink create 1 1 1 1 1
1.70 + list [catch {set bool gorp} msg] $msg $bool
1.71 +} {1 {can't set "bool": variable must have boolean value} 1}
1.72 +test link-2.5 {writing bad values into variables} {testlink} {
1.73 + testlink delete
1.74 + testlink set 43 1.23 4 - 56785678
1.75 + testlink create 1 1 1 1 1
1.76 + list [catch {set wide gorp} msg] $msg $bool
1.77 +} {1 {can't set "wide": variable must have integer value} 1}
1.78 +
1.79 +test link-3.1 {read-only variables} {testlink} {
1.80 + testlink delete
1.81 + testlink set 43 1.23 4 - 56785678
1.82 + testlink create 0 1 1 0 0
1.83 + list [catch {set int 4} msg] $msg $int \
1.84 + [catch {set real 10.6} msg] $msg $real \
1.85 + [catch {set bool no} msg] $msg $bool \
1.86 + [catch {set string "new value"} msg] $msg $string \
1.87 + [catch {set wide 12341234} msg] $msg $wide
1.88 +} {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}
1.89 +test link-3.2 {read-only variables} {testlink} {
1.90 + testlink delete
1.91 + testlink set 43 1.23 4 - 56785678
1.92 + testlink create 1 0 0 1 1
1.93 + list [catch {set int 4} msg] $msg $int \
1.94 + [catch {set real 10.6} msg] $msg $real \
1.95 + [catch {set bool no} msg] $msg $bool \
1.96 + [catch {set string "new value"} msg] $msg $string\
1.97 + [catch {set wide 12341234} msg] $msg $wide
1.98 +} {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}
1.99 +
1.100 +test link-4.1 {unsetting linked variables} {testlink} {
1.101 + testlink delete
1.102 + testlink set -6 -2.5 0 stringValue 13579
1.103 + testlink create 1 1 1 1 1
1.104 + unset int real bool string wide
1.105 + list [catch {set int} msg] $msg [catch {set real} msg] $msg \
1.106 + [catch {set bool} msg] $msg [catch {set string} msg] $msg \
1.107 + [catch {set wide} msg] $msg
1.108 +} {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
1.109 +test link-4.2 {unsetting linked variables} {testlink} {
1.110 + testlink delete
1.111 + testlink set -6 -2.1 0 stringValue 97531
1.112 + testlink create 1 1 1 1 1
1.113 + unset int real bool string wide
1.114 + set int 102
1.115 + set real 16
1.116 + set bool true
1.117 + set string newValue
1.118 + set wide 333555
1.119 + testlink get
1.120 +} {102 16.0 1 newValue 333555}
1.121 +
1.122 +test link-5.1 {unlinking variables} {testlink} {
1.123 + testlink delete
1.124 + testlink set -6 -2.25 0 stringValue 13579
1.125 + testlink delete
1.126 + set int xx1
1.127 + set real qrst
1.128 + set bool bogus
1.129 + set string 12345
1.130 + set wide 875421
1.131 + testlink get
1.132 +} {-6 -2.25 0 stringValue 13579}
1.133 +test link-5.2 {unlinking variables} {testlink} {
1.134 + testlink delete
1.135 + testlink set -6 -2.25 0 stringValue 97531
1.136 + testlink create 1 1 1 1 1
1.137 + testlink delete
1.138 + testlink set 25 14.7 7 - 999999
1.139 + list $int $real $bool $string $wide
1.140 +} {-6 -2.25 0 stringValue 97531}
1.141 +
1.142 +test link-6.1 {errors in setting up link} {testlink} {
1.143 + testlink delete
1.144 + catch {unset int}
1.145 + set int(44) 1
1.146 + list [catch {testlink create 1 1 1 1 1} msg] $msg
1.147 +} {1 {can't set "int": variable is array}}
1.148 +catch {unset int}
1.149 +
1.150 +test link-7.1 {access to linked variables via upvar} {testlink} {
1.151 + proc x {} {
1.152 + upvar int y
1.153 + unset y
1.154 + }
1.155 + testlink delete
1.156 + testlink create 1 0 0 0 0
1.157 + testlink set 14 {} {} {} {}
1.158 + x
1.159 + list [catch {set int} msg] $msg
1.160 +} {0 14}
1.161 +test link-7.2 {access to linked variables via upvar} {testlink} {
1.162 + proc x {} {
1.163 + upvar int y
1.164 + return [set y]
1.165 + }
1.166 + testlink delete
1.167 + testlink create 1 0 0 0 0
1.168 + testlink set 0 {} {} {} {}
1.169 + set int
1.170 + testlink set 23 {} {} {} {}
1.171 + x
1.172 + list [x] $int
1.173 +} {23 23}
1.174 +test link-7.3 {access to linked variables via upvar} {testlink} {
1.175 + proc x {} {
1.176 + upvar int y
1.177 + set y 44
1.178 + }
1.179 + testlink delete
1.180 + testlink create 0 0 0 0 0
1.181 + testlink set 11 {} {} {} {}
1.182 + list [catch x msg] $msg $int
1.183 +} {1 {can't set "y": linked variable is read-only} 11}
1.184 +test link-7.4 {access to linked variables via upvar} {testlink} {
1.185 + proc x {} {
1.186 + upvar int y
1.187 + set y abc
1.188 + }
1.189 + testlink delete
1.190 + testlink create 1 1 1 1 1
1.191 + testlink set -4 {} {} {} {}
1.192 + list [catch x msg] $msg $int
1.193 +} {1 {can't set "y": variable must have integer value} -4}
1.194 +test link-7.5 {access to linked variables via upvar} {testlink} {
1.195 + proc x {} {
1.196 + upvar real y
1.197 + set y abc
1.198 + }
1.199 + testlink delete
1.200 + testlink create 1 1 1 1 1
1.201 + testlink set -4 16.75 {} {} {}
1.202 + list [catch x msg] $msg $real
1.203 +} {1 {can't set "y": variable must have real value} 16.75}
1.204 +test link-7.6 {access to linked variables via upvar} {testlink} {
1.205 + proc x {} {
1.206 + upvar bool y
1.207 + set y abc
1.208 + }
1.209 + testlink delete
1.210 + testlink create 1 1 1 1 1
1.211 + testlink set -4 16.3 1 {} {}
1.212 + list [catch x msg] $msg $bool
1.213 +} {1 {can't set "y": variable must have boolean value} 1}
1.214 +test link-7.7 {access to linked variables via upvar} {testlink} {
1.215 + proc x {} {
1.216 + upvar wide y
1.217 + set y abc
1.218 + }
1.219 + testlink delete
1.220 + testlink create 1 1 1 1 1
1.221 + testlink set -4 16.3 1 {} 778899
1.222 + list [catch x msg] $msg $wide
1.223 +} {1 {can't set "y": variable must have integer value} 778899}
1.224 +
1.225 +test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
1.226 + proc x args {
1.227 + global x int real bool string wide
1.228 + lappend x $args $int $real $bool $string $wide
1.229 + }
1.230 + set x {}
1.231 + testlink create 1 1 1 1 1
1.232 + testlink set 14 -2.0 0 xyzzy 995511
1.233 + trace var int w x
1.234 + testlink update 32 4.0 3 abcd 113355
1.235 + trace vdelete int w x
1.236 + set x
1.237 +} {{int {} w} 32 -2.0 0 xyzzy 995511}
1.238 +test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
1.239 + proc x args {
1.240 + global x int real bool string wide
1.241 + lappend x $args $int $real $bool $string $wide
1.242 + }
1.243 + set x {}
1.244 + testlink create 1 1 1 1 1
1.245 + testlink set 14 -2.0 0 xyzzy 995511
1.246 + testlink delete
1.247 + trace var int w x
1.248 + testlink update 32 4.0 6 abcd 113355
1.249 + trace vdelete int w x
1.250 + set x
1.251 +} {}
1.252 +test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
1.253 + testlink create 0 0 0 0 0
1.254 + list [catch {testlink update 47 {} {} {} {}} msg] $msg $int
1.255 +} {0 {} 47}
1.256 +
1.257 +catch {testlink set 0 0 0 - 0}
1.258 +catch {testlink delete}
1.259 +foreach i {int real bool string wide} {
1.260 + catch {unset $i}
1.261 +}
1.262 +
1.263 +# cleanup
1.264 +::tcltest::cleanupTests
1.265 +return