diff options
Diffstat (limited to 'tests/stringObj.test')
| -rw-r--r-- | tests/stringObj.test | 127 |
1 files changed, 70 insertions, 57 deletions
diff --git a/tests/stringObj.test b/tests/stringObj.test index 5c8f88b..2f516ec 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -1,16 +1,16 @@ # Commands covered: none # -# This file contains tests for the procedures in tclStringObj.c -# that implement the Tcl type manager for the string type. +# This file contains tests for the procedures in tclStringObj.c that implement +# the Tcl type manager for the string type. # -# Sourcing this file into Tcl runs the tests and generates output for -# errors. No output means no errors were found. +# Sourcing this file into Tcl runs the tests and generates output for errors. +# No output means no errors were found. # # Copyright (c) 1995-1997 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 {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -18,7 +18,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } testConstraint testobj [llength [info commands testobj]] - +testConstraint testdstring [llength [info commands testdstring]] + test stringObj-1.1 {string type registration} testobj { set t [testobj types] set first [string first "string" $t] @@ -37,7 +38,7 @@ test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} testobj { set result "" lappend result [testobj freeallvars] lappend result [testobj newobj 1] - lappend result [teststringobj set 1 xyz] ;# makes existing obj a string + lappend result [teststringobj set 1 xyz] ;# makes existing obj a string lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} {} xyz string 2} @@ -45,7 +46,7 @@ test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} testob set result "" lappend result [testobj freeallvars] lappend result [testintobj set 1 512] - lappend result [teststringobj set 1 foo] ;# makes existing obj a string + lappend result [teststringobj set 1 foo] ;# makes existing obj a string lappend result [testobj type 1] lappend result [testobj refcount 1] } {{} 512 foo string 2} @@ -133,7 +134,7 @@ test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if init testobj newobj 1 teststringobj appendstrings 1 123 abcdefg list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1] -} {10 10 123abcdefg} +} {10 20 123abcdefg} test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj { testobj freeallvars teststringobj set 1 abc @@ -158,7 +159,7 @@ test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} test teststringobj appendstrings 1 {} list [teststringobj length2 1] [teststringobj get 1] } {0 {}} -test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} { +test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj { testobj freeallvars teststringobj set2 1 [string replace abc 1 1 d] teststringobj appendstrings 1 foo bar soom @@ -196,24 +197,24 @@ test stringObj-8.1 {DupStringInternalRep procedure} testobj { teststringobj append 1 abcde -1 testobj duplicate 1 2 list [teststringobj length 1] [teststringobj length2 1] \ - [teststringobj ualloc 1] [teststringobj get 1] \ + [teststringobj maxchars 1] [teststringobj get 1] \ [teststringobj length 2] [teststringobj length2 2] \ - [teststringobj ualloc 2] [teststringobj get 2] + [teststringobj maxchars 2] [teststringobj get 2] } {5 10 0 abcde 5 5 0 abcde} test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi string length $x set y $x - list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \ + list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string string abcï¿®ghi®¿ï abcï¿®ghi string string} +} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string" test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} testobj { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi set y $x string length $x - list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \ + list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string string abcï¿®ghi®¿ï abcï¿®ghi string string} +} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string" test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} testobj { set x abcdefghi string length $x @@ -229,31 +230,37 @@ test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} testobj { [set y] [testobj objtype $x] [testobj objtype $y] } {string string abcdefghijkl abcdefghi string string} -test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} testobj { - set x abcï¿®ghi - set y ®¿ï +test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {testobj testdstring} { + set x abc\u00ef\u00bf\u00aeghi + testdstring free + testdstring append \u00ae\u00bf\u00ef -1 + set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string none abcï¿®ghi®¿ï ®¿ï string none} +} "string none abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none" test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi string length $x list [testobj objtype $x] [append x $x] [testobj objtype $x] \ [append x $x] [testobj objtype $x] -} {string abcï¿®ghiabcï¿®ghi string\ -abcï¿®ghiabcï¿®ghiabcï¿®ghiabcï¿®ghi\ -string} -test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} testobj { +} "string abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi string\ +abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi\ +string" +test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj testdstring} { set x abcdefghi - set y ®¿ï + testdstring free + testdstring append \u00ae\u00bf\u00ef -1 + set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string none abcdefghi®¿ï ®¿ï string none} -test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} testobj { +} "string none abcdefghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none" +test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {testobj testdstring} { set x abcdefghi - set y jkl + testdstring free + testdstring append jkl -1 + set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] @@ -265,13 +272,15 @@ test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj { [append x $x] [testobj objtype $x] } {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\ string} -test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} testobj { - set x abcï¿®ghi - set y jkl +test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {testobj testdstring} { + set x abc\u00ef\u00bf\u00aeghi + testdstring free + testdstring append jkl -1 + set y [testdstring get] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string none abcï¿®ghijkl jkl string none} +} "string none abc\u00ef\u00bf\u00aeghijkl jkl string none" test stringObj-9.7 {TclAppendObjToObj, integer src & dest} testobj { set x [expr {4 * 5}] set y [expr {4 + 5}] @@ -292,20 +301,19 @@ test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} testobj { [set y] [testobj objtype $x] [testobj objtype $y] } {string int abcdefghi9 9 string int} test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} testobj { - set x abcï¿®ghi + set x abc\u00ef\u00bf\u00aeghi set y [expr {4 + 5}] string length $x list [testobj objtype $x] [testobj objtype $y] [append x $y] \ [set y] [testobj objtype $x] [testobj objtype $y] -} {string int abcï¿®ghi9 9 string int} +} "string int abc\u00ef\u00bf\u00aeghi9 9 string int" test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj { # bug 2678, in <=8.2.0, the second obj (the one to append) in - # Tcl_AppendObjToObj was not correctly checked to see if it was - # all one byte chars, so a unicode string would be added as one - # byte chars. + # Tcl_AppendObjToObj was not correctly checked to see if it was all one + # byte chars, so a unicode string would be added as one byte chars. set x abcdef set len [string length $x] - set y aübåcï + set y a\u00fcb\u00e5c\u00ef set len [string length $y] append x $y string length $x @@ -314,20 +322,24 @@ test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} tes lappend q [string index $x $i] } set q -} {a b c d e f a ü b å c ï} +} "a b c d e f a \u00fc b \u00e5 c \u00ef" -test stringObj-10.1 {Tcl_GetRange with all byte-size chars} testobj { - set x "abcdef" +test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring} { + testdstring free + testdstring append abcdef -1 + set x [testdstring get] list [testobj objtype $x] [set y [string range $x 1 end-1]] \ [testobj objtype $x] [testobj objtype $y] } [list none bcde string string] -test stringObj-10.2 {Tcl_GetRange with some mixed width chars} testobj { +test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstring} { # Because this test does not use \uXXXX notation below instead of - # hardcoding the values, it may fail in multibyte locales. However, - # we need to test that the parser produces untyped objects even when there - # are high-ASCII characters in the input (like "ï"). I don't know what + # hardcoding the values, it may fail in multibyte locales. However, we + # need to test that the parser produces untyped objects even when there + # are high-ASCII characters in the input (like "ï"). I don't know what # else to do but inline those characters here. - set x "abcïïdef" + testdstring free + testdstring append "abc\u00ef\u00efdef" -1 + set x [testdstring get] list [testobj objtype $x] [set y [string range $x 1 end-1]] \ [testobj objtype $x] [testobj objtype $y] } [list none "bc\u00EF\u00EFde" string string] @@ -376,15 +388,15 @@ test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} testobj { list [string index $x end] [string index $x end-1] } {i h} test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} testobj { - string index "ïa¿b®c®¿dï" 0 -} "ï" + string index "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" 0 +} "\u00ef" test stringObj-12.5 {Tcl_GetUniChar} testobj { - set x "ïa¿b®c®¿dï" + set x "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" list [string index $x 4] [string index $x 0] -} {® ï} +} "\u00ae \u00ef" test stringObj-12.6 {Tcl_GetUniChar} testobj { - string index "ïa¿b®cï¿d®" end -} "®" + string index "\u00efa\u00bfb\u00aec\u00ef\u00bfd\u00ae" end +} "\u00ae" test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} testobj { set a "" @@ -398,7 +410,7 @@ test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj { list [string length $a] [string length $a] } {6 6} test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj { - string length "®" + string length "\u00ae" } 1 test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj { # string length "￮￮" @@ -465,6 +477,7 @@ test stringObj-15.8 {Tcl_Append*ToObj: self appends} { teststringobj appendself2 1 3 } foo + if {[testConstraint testobj]} { testobj freeallvars } |