os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/obj.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/obj.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,670 @@
1.4 +# Functionality covered: this file contains a collection of tests for the
1.5 +# procedures in tclObj.c that implement Tcl's basic type support and the
1.6 +# type managers for the types boolean, double, and integer.
1.7 +#
1.8 +# Sourcing this file into Tcl runs the tests and generates output for
1.9 +# errors. No output means no errors were found.
1.10 +#
1.11 +# Copyright (c) 1995-1996 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: obj.test,v 1.7.2.1 2004/09/10 21:52:37 dkf Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +if {[info commands testobj] == {}} {
1.25 + puts "This application hasn't been compiled with the \"testobj\""
1.26 + puts "command, so I can't test the Tcl type and object support."
1.27 + ::tcltest::cleanupTests
1.28 + return
1.29 +}
1.30 +
1.31 +# Procedure to determine the integer range of the machine
1.32 +
1.33 +proc int_range {} {
1.34 + for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
1.35 + set MIN_INT [expr { $MIN_INT << 1 }]
1.36 + }
1.37 + set MAX_INT [expr { ~ $MIN_INT }]
1.38 + return [list $MIN_INT $MAX_INT]
1.39 +}
1.40 +
1.41 +# Procedure to determine the range of wide integers on the machine.
1.42 +
1.43 +proc wide_range {} {
1.44 + for { set MIN_WIDE [expr { wide(1) }] } { $MIN_WIDE > wide(0) } {} {
1.45 + set MIN_WIDE [expr { $MIN_WIDE << 1 }]
1.46 + }
1.47 + set MAX_WIDE [expr { ~ $MIN_WIDE }]
1.48 + return [list $MIN_WIDE $MAX_WIDE]
1.49 +}
1.50 +
1.51 +foreach { MIN_INT MAX_INT } [int_range] break
1.52 +foreach { MIN_WIDE MAX_WIDE } [wide_range] break
1.53 +::tcltest::testConstraint 32bit \
1.54 + [expr { $MAX_INT == 0x7fffffff }]
1.55 +::tcltest::testConstraint wideBiggerThanInt \
1.56 + [expr { $MAX_WIDE > wide($MAX_INT) }]
1.57 +
1.58 +test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {
1.59 + set r 1
1.60 + foreach {t} {
1.61 + {array search}
1.62 + boolean
1.63 + bytearray
1.64 + bytecode
1.65 + double
1.66 + end-offset
1.67 + index
1.68 + int
1.69 + list
1.70 + nsName
1.71 + procbody
1.72 + string
1.73 + } {
1.74 + set first [string first $t [testobj types]]
1.75 + set r [expr {$r && ($first != -1)}]
1.76 + }
1.77 + set result $r
1.78 +} {1}
1.79 +
1.80 +test obj-2.1 {Tcl_GetObjType error} {
1.81 + list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
1.82 +} {0 1 {no type foo found}}
1.83 +test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} {
1.84 + set result ""
1.85 + lappend result [testobj freeallvars]
1.86 + lappend result [testintobj set 1 12]
1.87 + lappend result [testobj convert 1 double]
1.88 + lappend result [testobj type 1]
1.89 + lappend result [testobj refcount 1]
1.90 +} {{} 12 12 double 3}
1.91 +
1.92 +test obj-3.1 {Tcl_ConvertToType error} {
1.93 + list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
1.94 +} {12.34 1 {expected integer but got "12.34"}}
1.95 +test obj-3.2 {Tcl_ConvertToType error, "empty string" object} {
1.96 + list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
1.97 +} {{} 1 {expected integer but got ""}}
1.98 +
1.99 +test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} {
1.100 + set result ""
1.101 + lappend result [testobj freeallvars]
1.102 + lappend result [testobj newobj 1]
1.103 + lappend result [testobj type 1]
1.104 + lappend result [testobj refcount 1]
1.105 +} {{} {} string 2}
1.106 +
1.107 +test obj-5.1 {Tcl_FreeObj} {
1.108 + set result ""
1.109 + lappend result [testintobj set 1 12345]
1.110 + lappend result [testobj freeallvars]
1.111 + lappend result [catch {testintobj get 1} msg]
1.112 + lappend result $msg
1.113 +} {12345 {} 1 {variable 1 is unset (NULL)}}
1.114 +
1.115 +test obj-6.1 {Tcl_DuplicateObj, object has internal rep} {
1.116 + set result ""
1.117 + lappend result [testobj freeallvars]
1.118 + lappend result [testintobj set 1 47]
1.119 + lappend result [testobj duplicate 1 2]
1.120 + lappend result [testintobj get 2]
1.121 + lappend result [testobj refcount 1]
1.122 + lappend result [testobj refcount 2]
1.123 +} {{} 47 47 47 2 3}
1.124 +test obj-6.2 {Tcl_DuplicateObj, "empty string" object} {
1.125 + set result ""
1.126 + lappend result [testobj freeallvars]
1.127 + lappend result [testobj newobj 1]
1.128 + lappend result [testobj duplicate 1 2]
1.129 + lappend result [testintobj get 2]
1.130 + lappend result [testobj refcount 1]
1.131 + lappend result [testobj refcount 2]
1.132 +} {{} {} {} {} 2 3}
1.133 +
1.134 +test obj-7.1 {Tcl_GetString, return existing string rep} {
1.135 + set result ""
1.136 + lappend result [testintobj set 1 47]
1.137 + lappend result [testintobj get2 1]
1.138 +} {47 47}
1.139 +test obj-7.2 {Tcl_GetString, "empty string" object} {
1.140 + set result ""
1.141 + lappend result [testobj newobj 1]
1.142 + lappend result [teststringobj append 1 abc -1]
1.143 + lappend result [teststringobj get2 1]
1.144 +} {{} abc abc}
1.145 +test obj-7.3 {Tcl_GetString, returns string internal rep (DString)} {
1.146 + set result ""
1.147 + lappend result [teststringobj set 1 xyz]
1.148 + lappend result [teststringobj append 1 abc -1]
1.149 + lappend result [teststringobj get2 1]
1.150 +} {xyz xyzabc xyzabc}
1.151 +test obj-7.4 {Tcl_GetString, recompute string rep from internal rep} {
1.152 + set result ""
1.153 + lappend result [testintobj set 1 77]
1.154 + lappend result [testintobj mult10 1]
1.155 + lappend result [teststringobj get2 1]
1.156 +} {77 770 770}
1.157 +
1.158 +test obj-8.1 {Tcl_GetStringFromObj, return existing string rep} {
1.159 + set result ""
1.160 + lappend result [testintobj set 1 47]
1.161 + lappend result [testintobj get 1]
1.162 +} {47 47}
1.163 +test obj-8.2 {Tcl_GetStringFromObj, "empty string" object} {
1.164 + set result ""
1.165 + lappend result [testobj newobj 1]
1.166 + lappend result [teststringobj append 1 abc -1]
1.167 + lappend result [teststringobj get 1]
1.168 +} {{} abc abc}
1.169 +test obj-8.3 {Tcl_GetStringFromObj, returns string internal rep (DString)} {
1.170 + set result ""
1.171 + lappend result [teststringobj set 1 xyz]
1.172 + lappend result [teststringobj append 1 abc -1]
1.173 + lappend result [teststringobj get 1]
1.174 +} {xyz xyzabc xyzabc}
1.175 +test obj-8.4 {Tcl_GetStringFromObj, recompute string rep from internal rep} {
1.176 + set result ""
1.177 + lappend result [testintobj set 1 77]
1.178 + lappend result [testintobj mult10 1]
1.179 + lappend result [teststringobj get 1]
1.180 +} {77 770 770}
1.181 +
1.182 +test obj-9.1 {Tcl_NewBooleanObj} {
1.183 + set result ""
1.184 + lappend result [testobj freeallvars]
1.185 + lappend result [testbooleanobj set 1 0]
1.186 + lappend result [testobj type 1]
1.187 + lappend result [testobj refcount 1]
1.188 +} {{} 0 boolean 2}
1.189 +
1.190 +test obj-10.1 {Tcl_SetBooleanObj, existing "empty string" object} {
1.191 + set result ""
1.192 + lappend result [testobj freeallvars]
1.193 + lappend result [testobj newobj 1]
1.194 + lappend result [testbooleanobj set 1 0] ;# makes existing obj boolean
1.195 + lappend result [testobj type 1]
1.196 + lappend result [testobj refcount 1]
1.197 +} {{} {} 0 boolean 2}
1.198 +test obj-10.2 {Tcl_SetBooleanObj, existing non-"empty string" object} {
1.199 + set result ""
1.200 + lappend result [testobj freeallvars]
1.201 + lappend result [testintobj set 1 98765]
1.202 + lappend result [testbooleanobj set 1 1] ;# makes existing obj boolean
1.203 + lappend result [testobj type 1]
1.204 + lappend result [testobj refcount 1]
1.205 +} {{} 98765 1 boolean 2}
1.206 +
1.207 +test obj-11.1 {Tcl_GetBooleanFromObj, existing boolean object} {
1.208 + set result ""
1.209 + lappend result [testbooleanobj set 1 1]
1.210 + lappend result [testbooleanobj not 1] ;# gets existing boolean rep
1.211 +} {1 0}
1.212 +test obj-11.2 {Tcl_GetBooleanFromObj, convert to boolean} {
1.213 + set result ""
1.214 + lappend result [testintobj set 1 47]
1.215 + lappend result [testbooleanobj not 1] ;# must convert to bool
1.216 + lappend result [testobj type 1]
1.217 +} {47 0 boolean}
1.218 +test obj-11.3 {Tcl_GetBooleanFromObj, error converting to boolean} {
1.219 + set result ""
1.220 + lappend result [teststringobj set 1 abc]
1.221 + lappend result [catch {testbooleanobj not 1} msg]
1.222 + lappend result $msg
1.223 +} {abc 1 {expected boolean value but got "abc"}}
1.224 +test obj-11.4 {Tcl_GetBooleanFromObj, error converting from "empty string"} {
1.225 + set result ""
1.226 + lappend result [testobj newobj 1]
1.227 + lappend result [catch {testbooleanobj not 1} msg]
1.228 + lappend result $msg
1.229 +} {{} 1 {expected boolean value but got ""}}
1.230 +test obj-11.5 {Tcl_GetBooleanFromObj, convert hex to boolean} {
1.231 + set result ""
1.232 + lappend result [teststringobj set 1 0xac]
1.233 + lappend result [testbooleanobj not 1]
1.234 + lappend result [testobj type 1]
1.235 +} {0xac 0 boolean}
1.236 +test obj-11.6 {Tcl_GetBooleanFromObj, convert float to boolean} {
1.237 + set result ""
1.238 + lappend result [teststringobj set 1 5.42]
1.239 + lappend result [testbooleanobj not 1]
1.240 + lappend result [testobj type 1]
1.241 +} {5.42 0 boolean}
1.242 +
1.243 +test obj-12.1 {DupBooleanInternalRep} {
1.244 + set result ""
1.245 + lappend result [testbooleanobj set 1 1]
1.246 + lappend result [testobj duplicate 1 2] ;# uses DupBooleanInternalRep
1.247 + lappend result [testbooleanobj get 2]
1.248 +} {1 1 1}
1.249 +
1.250 +test obj-13.1 {SetBooleanFromAny, int to boolean special case} {
1.251 + set result ""
1.252 + lappend result [testintobj set 1 1234]
1.253 + lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
1.254 + lappend result [testobj type 1]
1.255 +} {1234 0 boolean}
1.256 +test obj-13.2 {SetBooleanFromAny, double to boolean special case} {
1.257 + set result ""
1.258 + lappend result [testdoubleobj set 1 3.14159]
1.259 + lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
1.260 + lappend result [testobj type 1]
1.261 +} {3.14159 0 boolean}
1.262 +test obj-13.3 {SetBooleanFromAny, special case strings representing booleans} {
1.263 + set result ""
1.264 + foreach s {yes no true false on off} {
1.265 + teststringobj set 1 $s
1.266 + lappend result [testbooleanobj not 1]
1.267 + }
1.268 + lappend result [testobj type 1]
1.269 +} {0 1 0 1 0 1 boolean}
1.270 +test obj-13.4 {SetBooleanFromAny, recompute string rep then parse it} {
1.271 + set result ""
1.272 + lappend result [testintobj set 1 456]
1.273 + lappend result [testintobj div10 1]
1.274 + lappend result [testbooleanobj not 1] ;# converts with SetBooleanFromAny
1.275 + lappend result [testobj type 1]
1.276 +} {456 45 0 boolean}
1.277 +test obj-13.5 {SetBooleanFromAny, error parsing string} {
1.278 + set result ""
1.279 + lappend result [teststringobj set 1 abc]
1.280 + lappend result [catch {testbooleanobj not 1} msg]
1.281 + lappend result $msg
1.282 +} {abc 1 {expected boolean value but got "abc"}}
1.283 +test obj-13.6 {SetBooleanFromAny, error parsing string} {
1.284 + set result ""
1.285 + lappend result [teststringobj set 1 x1.0]
1.286 + lappend result [catch {testbooleanobj not 1} msg]
1.287 + lappend result $msg
1.288 +} {x1.0 1 {expected boolean value but got "x1.0"}}
1.289 +test obj-13.7 {SetBooleanFromAny, error converting from "empty string"} {
1.290 + set result ""
1.291 + lappend result [testobj newobj 1]
1.292 + lappend result [catch {testbooleanobj not 1} msg]
1.293 + lappend result $msg
1.294 +} {{} 1 {expected boolean value but got ""}}
1.295 +test obj-13.8 {SetBooleanFromAny, unicode strings} {
1.296 + set result ""
1.297 + lappend result [teststringobj set 1 1\u7777]
1.298 + lappend result [catch {testbooleanobj not 1} msg]
1.299 + lappend result $msg
1.300 +} "1\u7777 1 {expected boolean value but got \"1\u7777\"}"
1.301 +
1.302 +test obj-14.1 {UpdateStringOfBoolean} {
1.303 + set result ""
1.304 + lappend result [testbooleanobj set 1 0]
1.305 + lappend result [testbooleanobj not 1]
1.306 + lappend result [testbooleanobj get 1] ;# must update string rep
1.307 +} {0 1 1}
1.308 +
1.309 +test obj-15.1 {Tcl_NewDoubleObj} {
1.310 + set result ""
1.311 + lappend result [testobj freeallvars]
1.312 + lappend result [testdoubleobj set 1 3.1459]
1.313 + lappend result [testobj type 1]
1.314 + lappend result [testobj refcount 1]
1.315 +} {{} 3.1459 double 2}
1.316 +
1.317 +test obj-16.1 {Tcl_SetDoubleObj, existing "empty string" object} {
1.318 + set result ""
1.319 + lappend result [testobj freeallvars]
1.320 + lappend result [testobj newobj 1]
1.321 + lappend result [testdoubleobj set 1 0.123] ;# makes existing obj boolean
1.322 + lappend result [testobj type 1]
1.323 + lappend result [testobj refcount 1]
1.324 +} {{} {} 0.123 double 2}
1.325 +test obj-16.2 {Tcl_SetDoubleObj, existing non-"empty string" object} {
1.326 + set result ""
1.327 + lappend result [testobj freeallvars]
1.328 + lappend result [testintobj set 1 98765]
1.329 + lappend result [testdoubleobj set 1 27.56] ;# makes existing obj double
1.330 + lappend result [testobj type 1]
1.331 + lappend result [testobj refcount 1]
1.332 +} {{} 98765 27.56 double 2}
1.333 +
1.334 +test obj-17.1 {Tcl_GetDoubleFromObj, existing double object} {
1.335 + set result ""
1.336 + lappend result [testdoubleobj set 1 16.1]
1.337 + lappend result [testdoubleobj mult10 1] ;# gets existing double rep
1.338 +} {16.1 161.0}
1.339 +test obj-17.2 {Tcl_GetDoubleFromObj, convert to double} {
1.340 + set result ""
1.341 + lappend result [testintobj set 1 477]
1.342 + lappend result [testdoubleobj div10 1] ;# must convert to bool
1.343 + lappend result [testobj type 1]
1.344 +} {477 47.7 double}
1.345 +test obj-17.3 {Tcl_GetDoubleFromObj, error converting to double} {
1.346 + set result ""
1.347 + lappend result [teststringobj set 1 abc]
1.348 + lappend result [catch {testdoubleobj mult10 1} msg]
1.349 + lappend result $msg
1.350 +} {abc 1 {expected floating-point number but got "abc"}}
1.351 +test obj-17.4 {Tcl_GetDoubleFromObj, error converting from "empty string"} {
1.352 + set result ""
1.353 + lappend result [testobj newobj 1]
1.354 + lappend result [catch {testdoubleobj div10 1} msg]
1.355 + lappend result $msg
1.356 +} {{} 1 {expected floating-point number but got ""}}
1.357 +
1.358 +test obj-18.1 {DupDoubleInternalRep} {
1.359 + set result ""
1.360 + lappend result [testdoubleobj set 1 17.1]
1.361 + lappend result [testobj duplicate 1 2] ;# uses DupDoubleInternalRep
1.362 + lappend result [testdoubleobj get 2]
1.363 +} {17.1 17.1 17.1}
1.364 +
1.365 +test obj-19.1 {SetDoubleFromAny, int to double special case} {
1.366 + set result ""
1.367 + lappend result [testintobj set 1 1234]
1.368 + lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
1.369 + lappend result [testobj type 1]
1.370 +} {1234 12340.0 double}
1.371 +test obj-19.2 {SetDoubleFromAny, boolean to double special case} {
1.372 + set result ""
1.373 + lappend result [testbooleanobj set 1 1]
1.374 + lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
1.375 + lappend result [testobj type 1]
1.376 +} {1 10.0 double}
1.377 +test obj-19.3 {SetDoubleFromAny, recompute string rep then parse it} {
1.378 + set result ""
1.379 + lappend result [testintobj set 1 456]
1.380 + lappend result [testintobj div10 1]
1.381 + lappend result [testdoubleobj mult10 1] ;# converts with SetDoubleFromAny
1.382 + lappend result [testobj type 1]
1.383 +} {456 45 450.0 double}
1.384 +test obj-19.4 {SetDoubleFromAny, error parsing string} {
1.385 + set result ""
1.386 + lappend result [teststringobj set 1 abc]
1.387 + lappend result [catch {testdoubleobj mult10 1} msg]
1.388 + lappend result $msg
1.389 +} {abc 1 {expected floating-point number but got "abc"}}
1.390 +test obj-19.5 {SetDoubleFromAny, error parsing string} {
1.391 + set result ""
1.392 + lappend result [teststringobj set 1 x1.0]
1.393 + lappend result [catch {testdoubleobj mult10 1} msg]
1.394 + lappend result $msg
1.395 +} {x1.0 1 {expected floating-point number but got "x1.0"}}
1.396 +test obj-19.6 {SetDoubleFromAny, error converting from "empty string"} {
1.397 + set result ""
1.398 + lappend result [testobj newobj 1]
1.399 + lappend result [catch {testdoubleobj div10 1} msg]
1.400 + lappend result $msg
1.401 +} {{} 1 {expected floating-point number but got ""}}
1.402 +
1.403 +test obj-20.1 {UpdateStringOfDouble} {
1.404 + set result ""
1.405 + lappend result [testdoubleobj set 1 3.14159]
1.406 + lappend result [testdoubleobj mult10 1]
1.407 + lappend result [testdoubleobj get 1] ;# must update string rep
1.408 +} {3.14159 31.4159 31.4159}
1.409 +
1.410 +test obj-21.1 {Tcl_NewIntObj} {
1.411 + set result ""
1.412 + lappend result [testobj freeallvars]
1.413 + lappend result [testintobj set 1 55]
1.414 + lappend result [testobj type 1]
1.415 + lappend result [testobj refcount 1]
1.416 +} {{} 55 int 2}
1.417 +
1.418 +test obj-22.1 {Tcl_SetIntObj, existing "empty string" object} {
1.419 + set result ""
1.420 + lappend result [testobj freeallvars]
1.421 + lappend result [testobj newobj 1]
1.422 + lappend result [testintobj set 1 77] ;# makes existing obj int
1.423 + lappend result [testobj type 1]
1.424 + lappend result [testobj refcount 1]
1.425 +} {{} {} 77 int 2}
1.426 +test obj-22.2 {Tcl_SetIntObj, existing non-"empty string" object} {
1.427 + set result ""
1.428 + lappend result [testobj freeallvars]
1.429 + lappend result [testdoubleobj set 1 12.34]
1.430 + lappend result [testintobj set 1 77] ;# makes existing obj int
1.431 + lappend result [testobj type 1]
1.432 + lappend result [testobj refcount 1]
1.433 +} {{} 12.34 77 int 2}
1.434 +
1.435 +test obj-23.1 {Tcl_GetIntFromObj, existing int object} {
1.436 + set result ""
1.437 + lappend result [testintobj set 1 22]
1.438 + lappend result [testintobj mult10 1] ;# gets existing int rep
1.439 +} {22 220}
1.440 +test obj-23.2 {Tcl_GetIntFromObj, convert to int} {
1.441 + set result ""
1.442 + lappend result [testintobj set 1 477]
1.443 + lappend result [testintobj div10 1] ;# must convert to bool
1.444 + lappend result [testobj type 1]
1.445 +} {477 47 int}
1.446 +test obj-23.3 {Tcl_GetIntFromObj, error converting to int} {
1.447 + set result ""
1.448 + lappend result [teststringobj set 1 abc]
1.449 + lappend result [catch {testintobj mult10 1} msg]
1.450 + lappend result $msg
1.451 +} {abc 1 {expected integer but got "abc"}}
1.452 +test obj-23.4 {Tcl_GetIntFromObj, error converting from "empty string"} {
1.453 + set result ""
1.454 + lappend result [testobj newobj 1]
1.455 + lappend result [catch {testintobj div10 1} msg]
1.456 + lappend result $msg
1.457 +} {{} 1 {expected integer but got ""}}
1.458 +test obj-23.5 {Tcl_GetIntFromObj, integer too large to represent as non-long error} {nonPortable} {
1.459 + set result ""
1.460 + lappend result [testobj newobj 1]
1.461 + lappend result [testintobj inttoobigtest 1]
1.462 +} {{} 1}
1.463 +
1.464 +test obj-24.1 {DupIntInternalRep} {
1.465 + set result ""
1.466 + lappend result [testintobj set 1 23]
1.467 + lappend result [testobj duplicate 1 2] ;# uses DupIntInternalRep
1.468 + lappend result [testintobj get 2]
1.469 +} {23 23 23}
1.470 +
1.471 +test obj-25.1 {SetIntFromAny, int to int special case} {
1.472 + set result ""
1.473 + lappend result [testintobj set 1 1234]
1.474 + lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
1.475 + lappend result [testobj type 1]
1.476 +} {1234 12340 int}
1.477 +test obj-25.2 {SetIntFromAny, boolean to int special case} {
1.478 + set result ""
1.479 + lappend result [testbooleanobj set 1 1]
1.480 + lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
1.481 + lappend result [testobj type 1]
1.482 +} {1 10 int}
1.483 +test obj-25.3 {SetIntFromAny, recompute string rep then parse it} {
1.484 + set result ""
1.485 + lappend result [testintobj set 1 456]
1.486 + lappend result [testintobj div10 1]
1.487 + lappend result [testintobj mult10 1] ;# converts with SetIntFromAny
1.488 + lappend result [testobj type 1]
1.489 +} {456 45 450 int}
1.490 +test obj-25.4 {SetIntFromAny, error parsing string} {
1.491 + set result ""
1.492 + lappend result [teststringobj set 1 abc]
1.493 + lappend result [catch {testintobj mult10 1} msg]
1.494 + lappend result $msg
1.495 +} {abc 1 {expected integer but got "abc"}}
1.496 +test obj-25.5 {SetIntFromAny, error parsing string} {
1.497 + set result ""
1.498 + lappend result [teststringobj set 1 x17]
1.499 + lappend result [catch {testintobj mult10 1} msg]
1.500 + lappend result $msg
1.501 +} {x17 1 {expected integer but got "x17"}}
1.502 +test obj-25.6 {SetIntFromAny, integer too large} {nonPortable} {
1.503 + set result ""
1.504 + lappend result [teststringobj set 1 123456789012345678901]
1.505 + lappend result [catch {testintobj mult10 1} msg]
1.506 + lappend result $msg
1.507 +} {123456789012345678901 1 {integer value too large to represent}}
1.508 +test obj-25.7 {SetIntFromAny, error converting from "empty string"} {
1.509 + set result ""
1.510 + lappend result [testobj newobj 1]
1.511 + lappend result [catch {testintobj div10 1} msg]
1.512 + lappend result $msg
1.513 +} {{} 1 {expected integer but got ""}}
1.514 +
1.515 +test obj-26.1 {UpdateStringOfInt} {
1.516 + set result ""
1.517 + lappend result [testintobj set 1 512]
1.518 + lappend result [testintobj mult10 1]
1.519 + lappend result [testintobj get 1] ;# must update string rep
1.520 +} {512 5120 5120}
1.521 +
1.522 +test obj-27.1 {Tcl_NewLongObj} {
1.523 + set result ""
1.524 + lappend result [testobj freeallvars]
1.525 + testintobj setmaxlong 1
1.526 + lappend result [testintobj ismaxlong 1]
1.527 + lappend result [testobj type 1]
1.528 + lappend result [testobj refcount 1]
1.529 +} {{} 1 int 1}
1.530 +
1.531 +test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} {
1.532 + set result ""
1.533 + lappend result [testobj freeallvars]
1.534 + lappend result [testobj newobj 1]
1.535 + lappend result [testintobj setlong 1 77] ;# makes existing obj long int
1.536 + lappend result [testobj type 1]
1.537 + lappend result [testobj refcount 1]
1.538 +} {{} {} 77 int 2}
1.539 +test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} {
1.540 + set result ""
1.541 + lappend result [testobj freeallvars]
1.542 + lappend result [testdoubleobj set 1 12.34]
1.543 + lappend result [testintobj setlong 1 77] ;# makes existing obj long int
1.544 + lappend result [testobj type 1]
1.545 + lappend result [testobj refcount 1]
1.546 +} {{} 12.34 77 int 2}
1.547 +
1.548 +test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} {
1.549 + set result ""
1.550 + lappend result [testintobj setlong 1 22]
1.551 + lappend result [testintobj mult10 1] ;# gets existing long int rep
1.552 +} {22 220}
1.553 +test obj-29.2 {Tcl_GetLongFromObj, convert to long} {
1.554 + set result ""
1.555 + lappend result [testintobj setlong 1 477]
1.556 + lappend result [testintobj div10 1] ;# must convert to bool
1.557 + lappend result [testobj type 1]
1.558 +} {477 47 int}
1.559 +test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} {
1.560 + set result ""
1.561 + lappend result [teststringobj set 1 abc]
1.562 + lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
1.563 + lappend result $msg
1.564 +} {abc 1 {expected integer but got "abc"}}
1.565 +test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} {
1.566 + set result ""
1.567 + lappend result [testobj newobj 1]
1.568 + lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
1.569 + lappend result $msg
1.570 +} {{} 1 {expected integer but got ""}}
1.571 +
1.572 +test obj-30.1 {Ref counting and object deletion, simple types} {
1.573 + set result ""
1.574 + lappend result [testobj freeallvars]
1.575 + lappend result [testintobj set 1 1024]
1.576 + lappend result [testobj assign 1 2] ;# vars 1 and 2 share the int obj
1.577 + lappend result [testobj type 2]
1.578 + lappend result [testobj refcount 1]
1.579 + lappend result [testobj refcount 2]
1.580 + lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
1.581 + lappend result [testobj type 2]
1.582 + lappend result [testobj refcount 1]
1.583 + lappend result [testobj refcount 2]
1.584 +} {{} 1024 1024 int 4 4 0 boolean 3 2}
1.585 +
1.586 +
1.587 +test obj-31.1 {regenerate string rep of "end"} {
1.588 + testobj freeallvars
1.589 + teststringobj set 1 end
1.590 + testobj convert 1 end-offset
1.591 + testobj invalidateStringRep 1
1.592 +} end
1.593 +
1.594 +test obj-31.2 {regenerate string rep of "end-1"} {
1.595 + testobj freeallvars
1.596 + teststringobj set 1 end-0x1
1.597 + testobj convert 1 end-offset
1.598 + testobj invalidateStringRep 1
1.599 +} end-1
1.600 +
1.601 +test obj-31.3 {regenerate string rep of "end--1"} {
1.602 + testobj freeallvars
1.603 + teststringobj set 1 end--0x1
1.604 + testobj convert 1 end-offset
1.605 + testobj invalidateStringRep 1
1.606 +} end--1
1.607 +
1.608 +test obj-31.4 {regenerate string rep of "end-bigInteger"} {
1.609 + testobj freeallvars
1.610 + teststringobj set 1 end-0x7fffffff
1.611 + testobj convert 1 end-offset
1.612 + testobj invalidateStringRep 1
1.613 +} end-2147483647
1.614 +
1.615 +test obj-31.5 {regenerate string rep of "end--bigInteger"} {
1.616 + testobj freeallvars
1.617 + teststringobj set 1 end--0x7fffffff
1.618 + testobj convert 1 end-offset
1.619 + testobj invalidateStringRep 1
1.620 +} end--2147483647
1.621 +
1.622 +
1.623 +test obj-31.6 {regenerate string rep of "end--bigInteger"} {nonPortable} {
1.624 + testobj freeallvars
1.625 + teststringobj set 1 end--0x80000000
1.626 + testobj convert 1 end-offset
1.627 + testobj invalidateStringRep 1
1.628 +} end--2147483648
1.629 +
1.630 +test obj-32.1 {integer overflow on input} {32bit wideBiggerThanInt} {
1.631 + set x 0x8000; append x 0000
1.632 + list [string is integer $x] [expr { wide($x) }]
1.633 +} {1 2147483648}
1.634 +
1.635 +test obj-32.2 {integer overflow on input} {32bit wideBiggerThanInt} {
1.636 + set x 0xffff; append x ffff
1.637 + list [string is integer $x] [expr { wide($x) }]
1.638 +} {1 4294967295}
1.639 +
1.640 +test obj-32.3 {integer overflow on input} {32bit wideBiggerThanInt} {
1.641 + set x 0x10000; append x 0000
1.642 + list [string is integer $x] [expr { wide($x) }]
1.643 +} {0 4294967296}
1.644 +
1.645 +test obj-32.4 {integer overflow on input} {32bit wideBiggerThanInt} {
1.646 + set x -0x8000; append x 0000
1.647 + list [string is integer $x] [expr { wide($x) }]
1.648 +} {1 -2147483648}
1.649 +
1.650 +test obj-32.5 {integer overflow on input} {32bit wideBiggerThanInt} {
1.651 + set x -0x8000; append x 0001
1.652 + list [string is integer $x] [expr { wide($x) }]
1.653 +} {1 -2147483649}
1.654 +
1.655 +test obj-32.6 {integer overflow on input} {32bit wideBiggerThanInt} {
1.656 + set x -0xffff; append x ffff
1.657 + list [string is integer $x] [expr { wide($x) }]
1.658 +} {1 -4294967295}
1.659 +
1.660 +test obj-32.7 {integer overflow on input} {32bit wideBiggerThanInt} {
1.661 + set x -0x10000; append x 0000
1.662 + list [string is integer $x] [expr { wide($x) }]
1.663 +} {0 -4294967296}
1.664 +
1.665 +testobj freeallvars
1.666 +
1.667 +# cleanup
1.668 +::tcltest::cleanupTests
1.669 +return
1.670 +
1.671 +# Local Variables:
1.672 +# mode: tcl
1.673 +# End: