os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/stringObj.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/stringObj.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,440 @@
1.4 +# Commands covered: none
1.5 +#
1.6 +# This file contains tests for the procedures in tclStringObj.c
1.7 +# that implement the Tcl type manager for the string type.
1.8 +#
1.9 +# Sourcing this file into Tcl runs the tests and generates output for
1.10 +# errors. No output means no errors were found.
1.11 +#
1.12 +# Copyright (c) 1995-1997 Sun Microsystems, Inc.
1.13 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.14 +#
1.15 +# See the file "license.terms" for information on usage and redistribution
1.16 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.17 +#
1.18 +# RCS: @(#) $Id: stringObj.test,v 1.15 2003/02/11 18:46:33 hobbs Exp $
1.19 +
1.20 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.21 + package require tcltest
1.22 + namespace import -force ::tcltest::*
1.23 +}
1.24 +
1.25 +if {[info commands testobj] == {}} {
1.26 + puts "This application hasn't been compiled with the \"testobj\""
1.27 + puts "command, so I can't test the Tcl type and object support."
1.28 + ::tcltest::cleanupTests
1.29 + return
1.30 +}
1.31 +
1.32 +test stringObj-1.1 {string type registration} {
1.33 + set t [testobj types]
1.34 + set first [string first "string" $t]
1.35 + set result [expr {$first != -1}]
1.36 +} {1}
1.37 +
1.38 +test stringObj-2.1 {Tcl_NewStringObj} {
1.39 + set result ""
1.40 + lappend result [testobj freeallvars]
1.41 + lappend result [teststringobj set 1 abcd]
1.42 + lappend result [testobj type 1]
1.43 + lappend result [testobj refcount 1]
1.44 +} {{} abcd string 2}
1.45 +
1.46 +test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} {
1.47 + set result ""
1.48 + lappend result [testobj freeallvars]
1.49 + lappend result [testobj newobj 1]
1.50 + lappend result [teststringobj set 1 xyz] ;# makes existing obj a string
1.51 + lappend result [testobj type 1]
1.52 + lappend result [testobj refcount 1]
1.53 +} {{} {} xyz string 2}
1.54 +test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} {
1.55 + set result ""
1.56 + lappend result [testobj freeallvars]
1.57 + lappend result [testintobj set 1 512]
1.58 + lappend result [teststringobj set 1 foo] ;# makes existing obj a string
1.59 + lappend result [testobj type 1]
1.60 + lappend result [testobj refcount 1]
1.61 +} {{} 512 foo string 2}
1.62 +
1.63 +test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {
1.64 + testobj freeallvars
1.65 + teststringobj set 1 test
1.66 + teststringobj setlength 1 3
1.67 + list [teststringobj length 1] [teststringobj length2 1] \
1.68 + [teststringobj get 1]
1.69 +} {3 4 tes}
1.70 +test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {
1.71 + testobj freeallvars
1.72 + teststringobj set 1 abcdef
1.73 + teststringobj setlength 1 10
1.74 + list [teststringobj length 1] [teststringobj length2 1]
1.75 +} {10 10}
1.76 +test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {
1.77 + testobj freeallvars
1.78 + teststringobj set 1 abcdef
1.79 + teststringobj append 1 xyzq -1
1.80 + list [teststringobj length 1] [teststringobj length2 1] \
1.81 + [teststringobj get 1]
1.82 +} {10 20 abcdefxyzq}
1.83 +test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {
1.84 + testobj freeallvars
1.85 + testobj newobj 1
1.86 + teststringobj setlength 1 0
1.87 + list [teststringobj length2 1] [teststringobj get 1]
1.88 +} {0 {}}
1.89 +
1.90 +test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} {
1.91 + testobj freeallvars
1.92 + testintobj set2 1 43
1.93 + teststringobj append 1 xyz -1
1.94 + teststringobj get 1
1.95 +} {43xyz}
1.96 +test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} {
1.97 + testobj freeallvars
1.98 + teststringobj set 1 {x y }
1.99 + teststringobj append 1 bbCCddEE 4
1.100 + teststringobj append 1 123 -1
1.101 + teststringobj get 1
1.102 +} {x y bbCC123}
1.103 +test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {
1.104 + testobj freeallvars
1.105 + teststringobj set 1 xyz
1.106 + teststringobj setlength 1 15
1.107 + teststringobj setlength 1 2
1.108 + set result {}
1.109 + teststringobj append 1 1234567890123 -1
1.110 + lappend result [teststringobj length 1] [teststringobj length2 1]
1.111 + teststringobj setlength 1 10
1.112 + teststringobj append 1 abcdef -1
1.113 + lappend result [teststringobj length 1] [teststringobj length2 1] \
1.114 + [teststringobj get 1]
1.115 +} {15 15 16 32 xy12345678abcdef}
1.116 +
1.117 +test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} {
1.118 + testobj freeallvars
1.119 + teststringobj set2 1 [list a b]
1.120 + teststringobj appendstrings 1 xyz { 1234 } foo
1.121 + teststringobj get 1
1.122 +} {a bxyz 1234 foo}
1.123 +test stringObj-6.2 {Tcl_AppendStringsToObj procedure, counting space} {
1.124 + testobj freeallvars
1.125 + teststringobj set 1 abc
1.126 + teststringobj appendstrings 1
1.127 + list [teststringobj length 1] [teststringobj get 1]
1.128 +} {3 abc}
1.129 +test stringObj-6.3 {Tcl_AppendStringsToObj procedure, counting space} {
1.130 + testobj freeallvars
1.131 + teststringobj set 1 abc
1.132 + teststringobj appendstrings 1 {} {} {} {}
1.133 + list [teststringobj length 1] [teststringobj get 1]
1.134 +} {3 abc}
1.135 +test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} {
1.136 + testobj freeallvars
1.137 + teststringobj set 1 abc
1.138 + teststringobj appendstrings 1 { 123 } abcdefg
1.139 + list [teststringobj length 1] [teststringobj get 1]
1.140 +} {15 {abc 123 abcdefg}}
1.141 +test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {
1.142 + testobj freeallvars
1.143 + testobj newobj 1
1.144 + teststringobj appendstrings 1 123 abcdefg
1.145 + list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
1.146 +} {10 10 123abcdefg}
1.147 +test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {
1.148 + testobj freeallvars
1.149 + teststringobj set 1 abc
1.150 + teststringobj setlength 1 10
1.151 + teststringobj setlength 1 2
1.152 + teststringobj appendstrings 1 34567890
1.153 + list [teststringobj length 1] [teststringobj length2 1] \
1.154 + [teststringobj get 1]
1.155 +} {10 10 ab34567890}
1.156 +test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {
1.157 + testobj freeallvars
1.158 + teststringobj set 1 abc
1.159 + teststringobj setlength 1 10
1.160 + teststringobj setlength 1 2
1.161 + teststringobj appendstrings 1 34567890x
1.162 + list [teststringobj length 1] [teststringobj length2 1] \
1.163 + [teststringobj get 1]
1.164 +} {11 22 ab34567890x}
1.165 +test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {
1.166 + testobj freeallvars
1.167 + testobj newobj 1
1.168 + teststringobj appendstrings 1 {}
1.169 + list [teststringobj length2 1] [teststringobj get 1]
1.170 +} {0 {}}
1.171 +
1.172 +test stringObj-7.1 {SetStringFromAny procedure} {
1.173 + testobj freeallvars
1.174 + teststringobj set2 1 [list a b]
1.175 + teststringobj append 1 x -1
1.176 + list [teststringobj length 1] [teststringobj length2 1] \
1.177 + [teststringobj get 1]
1.178 +} {4 8 {a bx}}
1.179 +test stringObj-7.2 {SetStringFromAny procedure, null object} {
1.180 + testobj freeallvars
1.181 + testobj newobj 1
1.182 + teststringobj appendstrings 1 {}
1.183 + list [teststringobj length 1] [teststringobj length2 1] \
1.184 + [teststringobj get 1]
1.185 +} {0 0 {}}
1.186 +test stringObj-7.3 {SetStringFromAny called with non-string obj} {
1.187 + set x 2345
1.188 + list [incr x] [testobj objtype $x] [string index $x end] \
1.189 + [testobj objtype $x]
1.190 +} {2346 int 6 string}
1.191 +test stringObj-7.4 {SetStringFromAny called with string obj} {
1.192 + set x "abcdef"
1.193 + list [string length $x] [testobj objtype $x] \
1.194 + [string length $x] [testobj objtype $x]
1.195 +} {6 string 6 string}
1.196 +
1.197 +test stringObj-8.1 {DupStringInternalRep procedure} {
1.198 + testobj freeallvars
1.199 + teststringobj set 1 {}
1.200 + teststringobj append 1 abcde -1
1.201 + testobj duplicate 1 2
1.202 + list [teststringobj length 1] [teststringobj length2 1] \
1.203 + [teststringobj ualloc 1] [teststringobj get 1] \
1.204 + [teststringobj length 2] [teststringobj length2 2] \
1.205 + [teststringobj ualloc 2] [teststringobj get 2]
1.206 +} {5 10 0 abcde 5 5 0 abcde}
1.207 +test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} {
1.208 + set x abcï¿®ghi
1.209 + string length $x
1.210 + set y $x
1.211 + list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
1.212 + [set y] [testobj objtype $x] [testobj objtype $y]
1.213 +} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
1.214 +test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} {
1.215 + set x abcï¿®ghi
1.216 + set y $x
1.217 + string length $x
1.218 + list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
1.219 + [set y] [testobj objtype $x] [testobj objtype $y]
1.220 +} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
1.221 +test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} {
1.222 + set x abcdefghi
1.223 + string length $x
1.224 + set y $x
1.225 + list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
1.226 + [set y] [testobj objtype $x] [testobj objtype $y]
1.227 +} {string string abcdefghijkl abcdefghi string string}
1.228 +test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} {
1.229 + set x abcdefghi
1.230 + set y $x
1.231 + string length $x
1.232 + list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
1.233 + [set y] [testobj objtype $x] [testobj objtype $y]
1.234 +} {string string abcdefghijkl abcdefghi string string}
1.235 +
1.236 +test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {
1.237 + set x abcï¿®ghi
1.238 + set y ®¿ï
1.239 + string length $x
1.240 + list [testobj objtype $x] [testobj objtype $y] [append x $y] \
1.241 + [set y] [testobj objtype $x] [testobj objtype $y]
1.242 +} {string none abcï¿®ghi®¿ï ®¿ï string none}
1.243 +test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} {
1.244 + set x abcï¿®ghi
1.245 + string length $x
1.246 + list [testobj objtype $x] [append x $x] [testobj objtype $x] \
1.247 + [append x $x] [testobj objtype $x]
1.248 +} {string abcï¿®ghiabcï¿®ghi string\
1.249 +abcï¿®ghiabcï¿®ghiabcï¿®ghiabcï¿®ghi\
1.250 +string}
1.251 +test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {
1.252 + set x abcdefghi
1.253 + set y ®¿ï
1.254 + string length $x
1.255 + list [testobj objtype $x] [testobj objtype $y] [append x $y] \
1.256 + [set y] [testobj objtype $x] [testobj objtype $y]
1.257 +} {string none abcdefghi®¿ï ®¿ï string none}
1.258 +test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {
1.259 + set x abcdefghi
1.260 + set y jkl
1.261 + string length $x
1.262 + list [testobj objtype $x] [testobj objtype $y] [append x $y] \
1.263 + [set y] [testobj objtype $x] [testobj objtype $y]
1.264 +} {string none abcdefghijkl jkl string none}
1.265 +test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} {
1.266 + set x abcdefghi
1.267 + string length $x
1.268 + list [testobj objtype $x] [append x $x] [testobj objtype $x] \
1.269 + [append x $x] [testobj objtype $x]
1.270 +} {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\
1.271 +string}
1.272 +test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {
1.273 + set x abcï¿®ghi
1.274 + set y jkl
1.275 + string length $x
1.276 + list [testobj objtype $x] [testobj objtype $y] [append x $y] \
1.277 + [set y] [testobj objtype $x] [testobj objtype $y]
1.278 +} {string none abcï¿®ghijkl jkl string none}
1.279 +test stringObj-9.7 {TclAppendObjToObj, integer src & dest} {
1.280 + set x [expr {4 * 5}]
1.281 + set y [expr {4 + 5}]
1.282 + list [testobj objtype $x] [testobj objtype $y] [append x $y] \
1.283 + [testobj objtype $x] [append x $y] [testobj objtype $x] \
1.284 + [testobj objtype $y]
1.285 +} {int int 209 string 2099 string int}
1.286 +test stringObj-9.8 {TclAppendObjToObj, integer src & dest} {
1.287 + set x [expr {4 * 5}]
1.288 + list [testobj objtype $x] [append x $x] [testobj objtype $x] \
1.289 + [append x $x] [testobj objtype $x]
1.290 +} {int 2020 string 20202020 string}
1.291 +test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} {
1.292 + set x abcdefghi
1.293 + set y [expr {4 + 5}]
1.294 + string length $x
1.295 + list [testobj objtype $x] [testobj objtype $y] [append x $y] \
1.296 + [set y] [testobj objtype $x] [testobj objtype $y]
1.297 +} {string int abcdefghi9 9 string int}
1.298 +test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} {
1.299 + set x abcï¿®ghi
1.300 + set y [expr {4 + 5}]
1.301 + string length $x
1.302 + list [testobj objtype $x] [testobj objtype $y] [append x $y] \
1.303 + [set y] [testobj objtype $x] [testobj objtype $y]
1.304 +} {string int abcï¿®ghi9 9 string int}
1.305 +test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} {
1.306 + # bug 2678, in <=8.2.0, the second obj (the one to append) in
1.307 + # Tcl_AppendObjToObj was not correctly checked to see if it was
1.308 + # all one byte chars, so a unicode string would be added as one
1.309 + # byte chars.
1.310 + set x abcdef
1.311 + set len [string length $x]
1.312 + set y aübåcï
1.313 + set len [string length $y]
1.314 + append x $y
1.315 + string length $x
1.316 + set q {}
1.317 + for {set i 0} {$i < 12} {incr i} {
1.318 + lappend q [string index $x $i]
1.319 + }
1.320 + set q
1.321 +} {a b c d e f a ü b å c ï}
1.322 +
1.323 +test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {
1.324 + set x "abcdef"
1.325 + list [testobj objtype $x] [set y [string range $x 1 end-1]] \
1.326 + [testobj objtype $x] [testobj objtype $y]
1.327 +} [list none bcde string string]
1.328 +test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {
1.329 + # Because this test does not use \uXXXX notation below instead of
1.330 + # hardcoding the values, it may fail in multibyte locales. However,
1.331 + # we need to test that the parser produces untyped objects even when there
1.332 + # are high-ASCII characters in the input (like "ï"). I don't know what
1.333 + # else to do but inline those characters here.
1.334 + set x "abcïïdef"
1.335 + list [testobj objtype $x] [set y [string range $x 1 end-1]] \
1.336 + [testobj objtype $x] [testobj objtype $y]
1.337 +} [list none "bc\u00EF\u00EFde" string string]
1.338 +test stringObj-10.3 {Tcl_GetRange with some mixed width chars} {
1.339 + # set x "abcïïdef"
1.340 + # Use \uXXXX notation below instead of hardcoding the values, otherwise
1.341 + # the test will fail in multibyte locales.
1.342 + set x "abc\u00EF\u00EFdef"
1.343 + string length $x
1.344 + list [testobj objtype $x] [set y [string range $x 1 end-1]] \
1.345 + [testobj objtype $x] [testobj objtype $y]
1.346 +} [list string "bc\u00EF\u00EFde" string string]
1.347 +test stringObj-10.4 {Tcl_GetRange with some mixed width chars} {
1.348 + # set a "ïa¿b®cï¿d®"
1.349 + # Use \uXXXX notation below instead of hardcoding the values, otherwise
1.350 + # the test will fail in multibyte locales.
1.351 + set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
1.352 + set result [list]
1.353 + while {[string length $a] > 0} {
1.354 + set a [string range $a 1 end-1]
1.355 + lappend result $a
1.356 + }
1.357 + set result
1.358 +} [list a\u00BFb\u00AEc\u00EF\u00BFd \
1.359 + \u00BFb\u00AEc\u00EF\u00BF \
1.360 + b\u00AEc\u00EF \
1.361 + \u00AEc \
1.362 + {}]
1.363 +
1.364 +test stringObj-11.1 {UpdateStringOfString} {
1.365 + set x 2345
1.366 + list [string index $x end] [testobj objtype $x] [incr x] \
1.367 + [testobj objtype $x]
1.368 +} {5 string 2346 int}
1.369 +
1.370 +test stringObj-12.1 {Tcl_GetUniChar with byte-size chars} {
1.371 + set x "abcdefghi"
1.372 + list [string index $x 0] [string index $x 1]
1.373 +} {a b}
1.374 +test stringObj-12.2 {Tcl_GetUniChar with byte-size chars} {
1.375 + set x "abcdefghi"
1.376 + list [string index $x 3] [string index $x end]
1.377 +} {d i}
1.378 +test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} {
1.379 + set x "abcdefghi"
1.380 + list [string index $x end] [string index $x end-1]
1.381 +} {i h}
1.382 +test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} {
1.383 + string index "ïa¿b®c®¿dï" 0
1.384 +} "ï"
1.385 +test stringObj-12.5 {Tcl_GetUniChar} {
1.386 + set x "ïa¿b®c®¿dï"
1.387 + list [string index $x 4] [string index $x 0]
1.388 +} {® ï}
1.389 +test stringObj-12.6 {Tcl_GetUniChar} {
1.390 + string index "ïa¿b®cï¿d®" end
1.391 +} "®"
1.392 +
1.393 +test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} {
1.394 + set a ""
1.395 + list [string length $a] [string length $a]
1.396 +} {0 0}
1.397 +test stringObj-13.2 {Tcl_GetCharLength with byte-size chars} {
1.398 + string length "a"
1.399 +} 1
1.400 +test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} {
1.401 + set a "abcdef"
1.402 + list [string length $a] [string length $a]
1.403 +} {6 6}
1.404 +test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} {
1.405 + string length "®"
1.406 +} 1
1.407 +test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} {
1.408 + # string length "￮￮"
1.409 + # Use \uXXXX notation below instead of hardcoding the values, otherwise
1.410 + # the test will fail in multibyte locales.
1.411 + string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
1.412 +} 6
1.413 +test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} {
1.414 + # set a "ïa¿b®cï¿d®"
1.415 + # Use \uXXXX notation below instead of hardcoding the values, otherwise
1.416 + # the test will fail in multibyte locales.
1.417 + set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
1.418 + list [string length $a] [string length $a]
1.419 +} {10 10}
1.420 +test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {
1.421 + # SF bug #684699
1.422 + string length [encoding convertfrom identity \x00]
1.423 +} 1
1.424 +test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {
1.425 + string length [encoding convertfrom identity \x01\x00\x02]
1.426 +} 3
1.427 +
1.428 +test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} {
1.429 + teststringobj set 1 foo
1.430 + teststringobj getunicode 1
1.431 + teststringobj append 1 bar -1
1.432 + teststringobj getunicode 1
1.433 + teststringobj append 1 bar -1
1.434 + teststringobj setlength 1 0
1.435 + teststringobj append 1 bar -1
1.436 + teststringobj get 1
1.437 +} {bar}
1.438 +
1.439 +testobj freeallvars
1.440 +
1.441 +# cleanup
1.442 +::tcltest::cleanupTests
1.443 +return