summaryrefslogtreecommitdiffstats
path: root/tests/stringObj.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/stringObj.test')
-rw-r--r--tests/stringObj.test78
1 files changed, 52 insertions, 26 deletions
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 135830c..c1633bf 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -19,14 +19,15 @@ if {"::tcltest" ni [namespace children]} {
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
+package require tcltests
testConstraint testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint tip389 [expr {[string length \U010000] == 2}]
-testConstraint nodep [info exists tcl_precision]
-
-test stringObj-1.1 {string type registration} testobj {
+testConstraint utf32 [expr {[string length [format %c 0x10000]] == 1}]
+
+test stringObj-1.1 {string type registration} {testobj deprecated} {
set t [testobj types]
set first [string first "string" $t]
set result [expr {$first >= 0}]
@@ -57,27 +58,27 @@ test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} testob
lappend result [testobj refcount 1]
} {{} 512 foo string 2}
-test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} testobj {
+test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 test
teststringobj setlength 1 3
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {3 4 tes}
-test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj {
+} {3 3 tes}
+test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {testobj deprecated} {
testobj freeallvars
teststringobj set 1 abcdef
teststringobj setlength 1 10
list [teststringobj length 1] [teststringobj length2 1]
} {10 10}
-test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj {
+test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 abcdef
teststringobj append 1 xyzq -1
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {10 20 abcdefxyzq}
-test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} testobj {
+} {10 10 abcdefxyzq}
+test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {testobj deprecated} {
testobj freeallvars
testobj newobj 1
teststringobj setlength 1 0
@@ -97,7 +98,7 @@ test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} testobj {
teststringobj append 1 123 -1
teststringobj get 1
} {x y bbCC123}
-test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} testobj {
+test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 xyz
teststringobj setlength 1 15
@@ -109,7 +110,7 @@ test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} testobj {
teststringobj append 1 abcdef -1
lappend result [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {15 15 16 32 xy12345678abcdef}
+} {15 15 16 16 xy12345678abcdef}
test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj {
testobj freeallvars
@@ -135,13 +136,13 @@ test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} testobj {
teststringobj appendstrings 1 { 123 } abcdefg
list [teststringobj length 1] [teststringobj get 1]
} {15 {abc 123 abcdefg}}
-test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj {
+test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {testobj utf32 deprecated} {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 123 abcdefg
list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
-} {10 20 123abcdefg}
-test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
+} {10 10 123abcdefg}
+test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {testobj deprecated} {
testobj freeallvars
teststringobj set 1 abc
teststringobj setlength 1 10
@@ -150,7 +151,7 @@ test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testob
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
} {10 10 ab34567890}
-test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
+test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 abc
teststringobj setlength 1 10
@@ -158,8 +159,8 @@ test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testob
teststringobj appendstrings 1 34567890x
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {11 22 ab34567890x}
-test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj {
+} {11 11 ab34567890x}
+test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {testobj deprecated} {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 {}
@@ -172,14 +173,14 @@ test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj {
teststringobj get 1
} adcfoobarsoom
-test stringObj-7.1 {SetStringFromAny procedure} testobj {
+test stringObj-7.1 {SetStringFromAny procedure} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set2 1 [list a b]
teststringobj append 1 x -1
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {4 8 {a bx}}
-test stringObj-7.2 {SetStringFromAny procedure, null object} testobj {
+} {4 4 {a bx}}
+test stringObj-7.2 {SetStringFromAny procedure, null object} {testobj deprecated} {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 {}
@@ -197,7 +198,7 @@ test stringObj-7.4 {SetStringFromAny called with string obj} testobj {
[string length $x] [testobj objtype $x]
} {6 string 6 string}
-test stringObj-8.1 {DupStringInternalRep procedure} testobj {
+test stringObj-8.1 {DupStringInternalRep procedure} {testobj utf32 deprecated} {
testobj freeallvars
teststringobj set 1 {}
teststringobj append 1 abcde -1
@@ -206,7 +207,7 @@ test stringObj-8.1 {DupStringInternalRep procedure} testobj {
[teststringobj maxchars 1] [teststringobj get 1] \
[teststringobj length 2] [teststringobj length2 2] \
[teststringobj maxchars 2] [teststringobj get 2]
-} {5 10 0 abcde 5 5 0 abcde}
+} {5 5 5 abcde 5 5 5 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
set x abc\xEF\xBF\xAEghi
string length $x
@@ -455,22 +456,47 @@ test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself 1 3
} foo
-test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
+test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 0
} foofoo
-test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
+test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 1
} foooo
-test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
+test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 2
} fooo
-test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
+test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated} {
teststringobj set 1 foo
teststringobj appendself2 1 3
} foo
+
+test stringObj-16.0 {Tcl_GetRange: normal case} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 1 3
+} bcd
+test stringObj-16.1 {Tcl_GetRange: first > end} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 10 5
+} {}
+test stringObj-16.2 {Tcl_GetRange: last > end} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 3 13
+} de
+test stringObj-16.3 {Tcl_GetRange: first = -1} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 -1 3
+} abcd
+test stringObj-16.4 {Tcl_GetRange: last = -1} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 1 -1
+} bcde
+test stringObj-16.5 {Tcl_GetRange: fist = last = -1} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 -1 -1
+} abcde
if {[testConstraint testobj]} {
testobj freeallvars
generated by cgit v0.12 at 2025-12-09 11:57:42 (GMT)