tcl/tests/stringObj.test

   1 # Commands covered: none
   2 #
   3 # This file contains tests for the procedures in tclStringObj.c
   4 # that implement the Tcl type manager for the string type.
   5 #
   6 # Sourcing this file into Tcl runs the tests and generates output for
   7 # errors. No output means no errors were found.
   8 #
   9 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
  10 # Copyright (c) 1998-1999 by Scriptics Corporation.
  11 #
  12 # See the file "license.terms" for information on usage and redistribution
  13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14 #
  15 # RCS: @(#) $Id$
  16
  17 if {[lsearch [namespace children] ::tcltest] == -1} {
  18     package require tcltest
  19     namespace import -force ::tcltest::*
  20 }
  21
  22 if {[info commands testobj] == {}} {
  23     puts "This application hasn't been compiled with the \"testobj\""
  24     puts "command, so I can't test the Tcl type and object support."
  25     ::tcltest::cleanupTests
  26     return
  27 }
  28
  29 test stringObj-1.1 {string type registration} {
  30     set t [testobj types]
  31     set first [string first "string" $t]
  32     set result [expr {$first != -1}]
  33 } {1}
  34
  35 test stringObj-2.1 {Tcl_NewStringObj} {
  36     set result ""
  37     lappend result [testobj freeallvars]
  38     lappend result [teststringobj set 1 abcd]
  39     lappend result [testobj type 1]
  40     lappend result [testobj refcount 1]
  41 } {{} abcd string 2}
  42
  43 test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} {
  44     set result ""
  45     lappend result [testobj freeallvars]
  46     lappend result [testobj newobj 1]
  47     lappend result [teststringobj set 1 xyz] ;# makes existing obj a string
  48     lappend result [testobj type 1]
  49     lappend result [testobj refcount 1]
  50 } {{} {} xyz string 2}
  51 test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} {
  52     set result ""
  53     lappend result [testobj freeallvars]
  54     lappend result [testintobj set 1 512]
  55     lappend result [teststringobj set 1 foo]  ;# makes existing obj a string
  56     lappend result [testobj type 1]
  57     lappend result [testobj refcount 1]
  58 } {{} 512 foo string 2}
  59
  60 test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {
  61     testobj freeallvars
  62     teststringobj set 1 test
  63     teststringobj setlength 1 3
  64     list [teststringobj length 1] [teststringobj length2 1] \
  65             [teststringobj get 1]
  66 } {3 4 tes}
  67 test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {
  68     testobj freeallvars
  69     teststringobj set 1 abcdef
  70     teststringobj setlength 1 10
  71     list [teststringobj length 1] [teststringobj length2 1]
  72 } {10 10}
  73 test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {
  74     testobj freeallvars
  75     teststringobj set 1 abcdef
  76     teststringobj append 1 xyzq -1
  77     list [teststringobj length 1] [teststringobj length2 1] \
  78             [teststringobj get 1]
  79 } {10 20 abcdefxyzq}
  80 test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {
  81     testobj freeallvars
  82     testobj newobj 1
  83     teststringobj setlength 1 0
  84     list [teststringobj length2 1] [teststringobj get 1]
  85 } {0 {}}
  86
  87 test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} {
  88     testobj freeallvars
  89     testintobj set2 1 43
  90     teststringobj append 1 xyz -1
  91     teststringobj get 1
  92 } {43xyz}
  93 test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} {
  94     testobj freeallvars
  95     teststringobj set 1 {x y }
  96     teststringobj append 1 bbCCddEE 4
  97     teststringobj append 1 123 -1
  98     teststringobj get 1
  99 } {x y bbCC123}
 100 test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {
 101     testobj freeallvars
 102     teststringobj set 1 xyz
 103     teststringobj setlength 1 15
 104     teststringobj setlength 1 2
 105     set result {}
 106     teststringobj append 1 1234567890123 -1
 107     lappend result [teststringobj length 1] [teststringobj length2 1]
 108     teststringobj setlength 1 10
 109     teststringobj append 1 abcdef -1
 110     lappend result [teststringobj length 1] [teststringobj length2 1] \
 111             [teststringobj get 1]
 112 } {15 15 16 32 xy12345678abcdef}
 113
 114 test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} {
 115     testobj freeallvars
 116     teststringobj set2 1 [list a b]
 117     teststringobj appendstrings 1 xyz { 1234 } foo
 118     teststringobj get 1
 119 } {a bxyz 1234 foo}
 120 test stringObj-6.2 {Tcl_AppendStringsToObj procedure, counting space} {
 121     testobj freeallvars
 122     teststringobj set 1 abc
 123     teststringobj appendstrings 1
 124     list [teststringobj length 1] [teststringobj get 1]
 125 } {3 abc}
 126 test stringObj-6.3 {Tcl_AppendStringsToObj procedure, counting space} {
 127     testobj freeallvars
 128     teststringobj set 1 abc
 129     teststringobj appendstrings 1 {} {} {} {}
 130     list [teststringobj length 1] [teststringobj get 1]
 131 } {3 abc}
 132 test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} {
 133     testobj freeallvars
 134     teststringobj set 1 abc
 135     teststringobj appendstrings 1 { 123 } abcdefg
 136     list [teststringobj length 1] [teststringobj get 1]
 137 } {15 {abc 123 abcdefg}}
 138 test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {
 139     testobj freeallvars
 140     testobj newobj 1
 141     teststringobj appendstrings 1 123 abcdefg
 142     list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
 143 } {10 10 123abcdefg}
 144 test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {
 145     testobj freeallvars
 146     teststringobj set 1 abc
 147     teststringobj setlength 1 10
 148     teststringobj setlength 1 2
 149     teststringobj appendstrings 1 34567890
 150     list [teststringobj length 1] [teststringobj length2 1] \
 151             [teststringobj get 1]
 152 } {10 10 ab34567890}
 153 test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {
 154     testobj freeallvars
 155     teststringobj set 1 abc
 156     teststringobj setlength 1 10
 157     teststringobj setlength 1 2
 158     teststringobj appendstrings 1 34567890x
 159     list [teststringobj length 1] [teststringobj length2 1] \
 160             [teststringobj get 1]
 161 } {11 22 ab34567890x}
 162 test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {
 163     testobj freeallvars
 164     testobj newobj 1
 165     teststringobj appendstrings 1 {}
 166     list [teststringobj length2 1] [teststringobj get 1]
 167 } {0 {}}
 168
 169 test stringObj-7.1 {SetStringFromAny procedure} {
 170     testobj freeallvars
 171     teststringobj set2 1 [list a b]
 172     teststringobj append 1 x -1
 173     list [teststringobj length 1] [teststringobj length2 1] \
 174             [teststringobj get 1]
 175 } {4 8 {a bx}}
 176 test stringObj-7.2 {SetStringFromAny procedure, null object} {
 177     testobj freeallvars
 178     testobj newobj 1
 179     teststringobj appendstrings 1 {}
 180     list [teststringobj length 1] [teststringobj length2 1] \
 181             [teststringobj get 1]
 182 } {0 0 {}}
 183 test stringObj-7.3 {SetStringFromAny called with non-string obj} {
 184     set x 2345
 185     list [incr x] [testobj objtype $x] [string index $x end] \
 186             [testobj objtype $x]
 187 } {2346 int 6 string}
 188 test stringObj-7.4 {SetStringFromAny called with string obj} {
 189     set x "abcdef"
 190     list [string length $x] [testobj objtype $x] \
 191             [string length $x] [testobj objtype $x]
 192 } {6 string 6 string}
 193
 194 test stringObj-8.1 {DupStringInternalRep procedure} {
 195     testobj freeallvars
 196     teststringobj set 1 {}
 197     teststringobj append 1 abcde -1
 198     testobj duplicate 1 2
 199     list [teststringobj length 1] [teststringobj length2 1] \
 200             [teststringobj ualloc 1] [teststringobj get 1] \
 201             [teststringobj length 2] [teststringobj length2 2] \
 202             [teststringobj ualloc 2] [teststringobj get 2]
 203 } {5 10 0 abcde 5 5 0 abcde}
 204 test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} {
 205     set x abc￮ghi
 206     string length $x
 207     set y $x
 208     list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
 209             [set y] [testobj objtype $x] [testobj objtype $y]
 210 } {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
 211 test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} {
 212     set x abc￮ghi
 213     set y $x
 214     string length $x
 215     list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
 216             [set y] [testobj objtype $x] [testobj objtype $y]
 217 } {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
 218 test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} {
 219     set x abcdefghi
 220     string length $x
 221     set y $x
 222     list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
 223             [set y] [testobj objtype $x] [testobj objtype $y]
 224 } {string string abcdefghijkl abcdefghi string string}
 225 test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} {
 226     set x abcdefghi
 227     set y $x
 228     string length $x
 229     list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
 230             [set y] [testobj objtype $x] [testobj objtype $y]
 231 } {string string abcdefghijkl abcdefghi string string}
 232
 233 test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {
 234     set x abc￮ghi
 235     set y ®¿ï
 236     string length $x
 237     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 238             [set y] [testobj objtype $x] [testobj objtype $y]
 239 } {string none abcï¿®ghi®¿ï ®¿ï string none}
 240 test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} {
 241     set x abc￮ghi
 242     string length $x
 243     list [testobj objtype $x] [append x $x] [testobj objtype $x] \
 244             [append x $x] [testobj objtype $x]
 245 } {string abc￮ghiabc￮ghi string\
 246 abc￮ghiabc￮ghiabc￮ghiabc￮ghi\
 247 string}
 248 test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {
 249     set x abcdefghi
 250     set y ®¿ï
 251     string length $x
 252     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 253             [set y] [testobj objtype $x] [testobj objtype $y]
 254 } {string none abcdefghi®¿ï ®¿ï string none}
 255 test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {
 256     set x abcdefghi
 257     set y jkl
 258     string length $x
 259     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 260             [set y] [testobj objtype $x] [testobj objtype $y]
 261 } {string none abcdefghijkl jkl string none}
 262 test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} {
 263     set x abcdefghi
 264     string length $x
 265     list [testobj objtype $x] [append x $x] [testobj objtype $x] \
 266             [append x $x] [testobj objtype $x]
 267 } {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\
 268 string}
 269 test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {
 270     set x abc￮ghi
 271     set y jkl
 272     string length $x
 273     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 274             [set y] [testobj objtype $x] [testobj objtype $y]
 275 } {string none abc￮ghijkl jkl string none}
 276 test stringObj-9.7 {TclAppendObjToObj, integer src & dest} {
 277     set x [expr {4 * 5}]
 278     set y [expr {4 + 5}]
 279     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 280             [testobj objtype $x] [append x $y] [testobj objtype $x] \
 281             [testobj objtype $y]
 282 } {int int 209 string 2099 string int}
 283 test stringObj-9.8 {TclAppendObjToObj, integer src & dest} {
 284     set x [expr {4 * 5}]
 285     list [testobj objtype $x] [append x $x] [testobj objtype $x] \
 286             [append x $x] [testobj objtype $x]
 287 } {int 2020 string 20202020 string}
 288 test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} {
 289     set x abcdefghi
 290     set y [expr {4 + 5}]
 291     string length $x
 292     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 293             [set y] [testobj objtype $x] [testobj objtype $y]
 294 } {string int abcdefghi9 9 string int}
 295 test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} {
 296     set x abc￮ghi
 297     set y [expr {4 + 5}]
 298     string length $x
 299     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 300             [set y] [testobj objtype $x] [testobj objtype $y]
 301 } {string int abc￮ghi9 9 string int}
 302 test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} {
 303     # bug 2678, in <=8.2.0, the second obj (the one to append) in
 304     # Tcl_AppendObjToObj was not correctly checked to see if it was
 305     # all one byte chars, so a unicode string would be added as one
 306     # byte chars.
 307     set x abcdef
 308     set len [string length $x]
 309     set y aübåcï
 310     set len [string length $y]
 311     append x $y
 312     string length $x
 313     set q {}
 314     for {set i 0} {$i < 12} {incr i} {
 315         lappend q [string index $x $i]
 316     }
 317     set q
 318 } {a b c d e f a ü b å c ï}
 319
 320 test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {
 321     set x "abcdef"
 322     list [testobj objtype $x] [set y [string range $x 1 end-1]] \
 323             [testobj objtype $x] [testobj objtype $y]
 324 } [list none bcde string string]
 325 test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {
 326     # Because this test does not use \uXXXX notation below instead of
 327     # hardcoding the values, it may fail in multibyte locales.  However,
 328     # we need to test that the parser produces untyped objects even when there
 329     # are high-ASCII characters in the input (like "ï").  I don't know what
 330     # else to do but inline those characters here.
 331     set x "abcïïdef"
 332     list [testobj objtype $x] [set y [string range $x 1 end-1]] \
 333             [testobj objtype $x] [testobj objtype $y]
 334 } [list none "bc\u00EF\u00EFde" string string]
 335 test stringObj-10.3 {Tcl_GetRange with some mixed width chars} {
 336     # set x "abcïïdef"
 337     # Use \uXXXX notation below instead of hardcoding the values, otherwise
 338     # the test will fail in multibyte locales.
 339     set x "abc\u00EF\u00EFdef"
 340     string length $x
 341     list [testobj objtype $x] [set y [string range $x 1 end-1]] \
 342             [testobj objtype $x] [testobj objtype $y]
 343 } [list string "bc\u00EF\u00EFde" string string]
 344 test stringObj-10.4 {Tcl_GetRange with some mixed width chars} {
 345     # set a "ïa¿b®cï¿d®"
 346     # Use \uXXXX notation below instead of hardcoding the values, otherwise
 347     # the test will fail in multibyte locales.
 348     set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
 349     set result [list]
 350     while {[string length $a] > 0} {
 351         set a [string range $a 1 end-1]
 352         lappend result $a
 353     }
 354     set result
 355 } [list a\u00BFb\u00AEc\u00EF\u00BFd    \
 356         \u00BFb\u00AEc\u00EF\u00BF      \
 357         b\u00AEc\u00EF                  \
 358         \u00AEc                         \
 359         {}]
 360
 361 test stringObj-11.1 {UpdateStringOfString} {
 362     set x 2345
 363     list [string index $x end] [testobj objtype $x] [incr x] \
 364             [testobj objtype $x]
 365 } {5 string 2346 int}
 366
 367 test stringObj-12.1 {Tcl_GetUniChar with byte-size chars} {
 368     set x "abcdefghi"
 369     list [string index $x 0] [string index $x 1]
 370 } {a b}
 371 test stringObj-12.2 {Tcl_GetUniChar with byte-size chars} {
 372     set x "abcdefghi"
 373     list [string index $x 3] [string index $x end]
 374 } {d i}
 375 test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} {
 376     set x "abcdefghi"
 377     list [string index $x end] [string index $x end-1]
 378 } {i h}
 379 test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} {
 380     string index "ïa¿b®c®¿dï" 0
 381 } "ï"
 382 test stringObj-12.5 {Tcl_GetUniChar} {
 383     set x "ïa¿b®c®¿dï"
 384     list [string index $x 4] [string index $x 0]
 385 } {® ï}
 386 test stringObj-12.6 {Tcl_GetUniChar} {
 387     string index "ïa¿b®cï¿d®" end
 388 } "®"
 389
 390 test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} {
 391     set a ""
 392     list [string length $a] [string length $a]
 393 } {0 0}
 394 test stringObj-13.2 {Tcl_GetCharLength with byte-size chars} {
 395     string length "a"
 396 } 1
 397 test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} {
 398     set a "abcdef"
 399     list [string length $a] [string length $a]
 400 } {6 6}
 401 test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} {
 402     string length "®"
 403 } 1
 404 test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} {
 405     # string length "￮￮"
 406     # Use \uXXXX notation below instead of hardcoding the values, otherwise
 407     # the test will fail in multibyte locales.
 408     string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
 409 } 6
 410 test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} {
 411     # set a "ïa¿b®cï¿d®"
 412     # Use \uXXXX notation below instead of hardcoding the values, otherwise
 413     # the test will fail in multibyte locales.
 414     set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
 415     list [string length $a] [string length $a]
 416 } {10 10}
 417
 418 testobj freeallvars
 419
 420 # cleanup
 421 ::tcltest::cleanupTests
 422 return
 423
 424
 425
 426
 427
 428
 429
 430
 431
 432
 433
 434