summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclStringObj.c145
-rw-r--r--tests/stringObj.test28
-rw-r--r--win/rules.vc4
3 files changed, 129 insertions, 48 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 2ab47f6..1c24716 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -89,6 +89,16 @@ static void UpdateStringOfUTF16String(Tcl_Obj *objPtr);
#if TCL_UTF_MAX < 4
#define uniCharStringType tclStringType
+#define GET_UNICHAR_STRING GET_STRING
+#define UniCharString String
+#define UNICHAR_STRING_MAXCHARS STRING_MAXCHARS
+#define uniCharStringAlloc stringAlloc
+#define uniCharStringRealloc stringRealloc
+#define uniCharStringAttemptAlloc stringAttemptAlloc
+#define uniCharStringAttemptRealloc stringAttemptRealloc
+#define uniCharStringCheckLimits stringCheckLimits
+#define SET_UNICHAR_STRING SET_STRING
+#define UNICHAR_STRING_SIZE STRING_SIZE
const Tcl_ObjType tclStringType = {
"string", /* name */
@@ -168,11 +178,9 @@ DupUTF16StringInternalRep(
* currently have an internal rep.*/
{
String *srcStringPtr = ((String *) (srcPtr)->internalRep.twoPtrValue.ptr1);
- size_t size = offsetof(String, unicode) + (((srcStringPtr->numChars) + 1U) * sizeof(unsigned short));
+ size_t size = offsetof(String, unicode) + (((srcStringPtr->allocated) + 1U) * sizeof(unsigned short));
String *copyStringPtr = (String *)ckalloc(size);
memcpy(copyStringPtr, srcStringPtr, size);
- copyStringPtr->allocated = srcStringPtr->numChars + 1;
- copyStringPtr->maxChars = srcStringPtr->numChars;
copyPtr->internalRep.twoPtrValue.ptr1 = copyStringPtr;
copyPtr->typePtr = &tclStringType;
@@ -184,6 +192,7 @@ SetUTF16StringFromAny(
Tcl_Obj *objPtr) /* The object to convert. */
{
if (!TclHasInternalRep(objPtr, &tclStringType)) {
+ Tcl_DString ds;
/*
* Convert whatever we have into an untyped value. Just A String.
@@ -192,30 +201,46 @@ SetUTF16StringFromAny(
(void) TclGetString(objPtr);
TclFreeInternalRep(objPtr);
- size_t size = offsetof(String, unicode) + (((objPtr->length) + 1U) * sizeof(unsigned short));
-
- String *stringPtr = (String *)ckalloc(size);
-
/*
* Create a basic String internalrep that just points to the UTF-8 string
* already in place at objPtr->bytes.
*/
- stringPtr->numChars = 0;
- stringPtr->allocated = objPtr->length + 1;
- stringPtr->maxChars = objPtr->length;
+ Tcl_DStringInit(&ds);
+ unsigned short *utf16string = Tcl_UtfToChar16DString(objPtr->bytes, objPtr->length, &ds);
+ size_t size = Tcl_DStringLength(&ds);
+ String *stringPtr = (String *)ckalloc((offsetof(String, unicode) + 2U) + size);
+ memcpy(stringPtr->unicode, utf16string, size);
+ stringPtr->unicode[size] = 0;
+ Tcl_DStringFree(&ds);
+
+ size /= sizeof(unsigned short);
+ stringPtr->numChars = size;
+ stringPtr->allocated = size;
+ stringPtr->maxChars = size;
stringPtr->hasUnicode = 1;
objPtr->internalRep.twoPtrValue.ptr1 = stringPtr;
objPtr->typePtr = &tclStringType;
}
- return TCL_OK;
+ return TCL_OK;
}
static void
UpdateStringOfUTF16String(
Tcl_Obj *objPtr) /* Object with string rep to update. */
{
- (void)objPtr;
+ Tcl_DString ds;
+ String *stringPtr = ((String *) (objPtr)->internalRep.twoPtrValue.ptr1);
+
+ Tcl_DStringInit(&ds);
+ const char *string = Tcl_Char16ToUtfDString(stringPtr->unicode, stringPtr->numChars, &ds);
+
+ char *bytes = (char *)ckalloc(Tcl_DStringLength(&ds) + 1U);
+ memcpy(bytes, string, Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ objPtr->bytes = bytes;
+ objPtr->length = Tcl_DStringLength(&ds);
+ printf("UpdateStringOfUTF16String %d %d\n", stringPtr->unicode[0], stringPtr->unicode[1]);
}
#endif
@@ -528,11 +553,21 @@ Tcl_NewUnicodeObj(
* string. */
{
Tcl_Obj *objPtr;
- (void)unicode;
- (void)numChars;
TclNewObj(objPtr);
- /* TODO JN */
+ TclFreeInternalRep(objPtr);
+
+ String *stringPtr = (String *)ckalloc((offsetof(String, unicode) + 2U) + numChars * sizeof(unsigned short));
+ memcpy(stringPtr->unicode, unicode, numChars);
+ stringPtr->unicode[numChars] = 0;
+
+ stringPtr->numChars = numChars;
+ stringPtr->allocated = numChars;
+ stringPtr->maxChars = numChars;
+ stringPtr->hasUnicode = 1;
+ objPtr->internalRep.twoPtrValue.ptr1 = stringPtr;
+ objPtr->typePtr = &tclStringType;
+
return objPtr;
}
#endif
@@ -823,11 +858,15 @@ Tcl_GetUnicodeFromObj(
* rep's unichar length should be stored. If
* NULL, no length is stored. */
{
- (void)objPtr;
- (void)lengthPtr;
+ String *stringPtr;
- /* TODO JN */
- return NULL;
+ SetUTF16StringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ if (lengthPtr != NULL) {
+ *lengthPtr = stringPtr->numChars;
+ }
+ return stringPtr->unicode;
}
#endif
@@ -839,12 +878,17 @@ TclGetUnicodeFromObj(
* rep's unichar length should be stored. If
* NULL, no length is stored. */
{
- (void)objPtr;
- (void)lengthPtr;
- /* TODO JN */
- return NULL;
+ String *stringPtr;
+
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+
+ if (lengthPtr != NULL) {
+ *lengthPtr = stringPtr->numChars;
+ }
+ return stringPtr->unicode;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1251,11 +1295,36 @@ Tcl_SetUnicodeObj(
int numChars) /* Number of characters in the unicode
* string. */
{
- (void)objPtr;
- (void)unicode;
- (void)numChars;
+ String *stringPtr;
- /* TODO JN */
+ if (numChars < 0) {
+ numChars = 0;
+
+ if (unicode) {
+ while (numChars >= 0 && unicode[numChars] != 0) {
+ numChars++;
+ }
+ }
+ stringCheckLimits(numChars);
+ }
+
+ /*
+ * Allocate enough space for the String structure + Unicode string.
+ */
+
+ stringCheckLimits(numChars);
+ stringPtr = stringAlloc(numChars);
+ SET_STRING(objPtr, stringPtr);
+ objPtr->typePtr = &tclStringType;
+
+ stringPtr->maxChars = numChars;
+ memcpy(stringPtr->unicode, unicode, numChars * sizeof(unsigned char));
+ stringPtr->unicode[numChars] = 0;
+ stringPtr->numChars = numChars;
+ stringPtr->hasUnicode = 1;
+
+ TclInvalidateStringRep(objPtr);
+ stringPtr->allocated = numChars;
}
static int
@@ -1490,11 +1559,23 @@ Tcl_AppendUnicodeToObj(
* object. */
int length) /* Number of chars in "unicode". */
{
- (void)objPtr;
- (void)unicode;
- (void)length;
+ String *stringPtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
+ }
+
+ if (length == 0) {
+ return;
+ }
- /* TODO JN */
+ SetStringFromAny(NULL, objPtr);
+ stringPtr = GET_STRING(objPtr);
+ stringPtr = stringAttemptRealloc(stringPtr, stringPtr->numChars + length);
+ memcpy(&stringPtr->unicode[stringPtr->numChars], unicode, length);
+ stringPtr->maxChars = stringPtr->allocated = stringPtr->numChars += length;
+ stringPtr->unicode[stringPtr->numChars] = 0;
+ SET_STRING(objPtr, stringPtr);
}
#endif
diff --git a/tests/stringObj.test b/tests/stringObj.test
index abe02b2..bae61ab 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -57,26 +57,26 @@ 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 fullutf} {
testobj freeallvars
teststringobj set 1 test
teststringobj setlength 1 3
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {3 4 tes}
+} {3 3 tes}
test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj {
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 fullutf} {
testobj freeallvars
teststringobj set 1 abcdef
teststringobj append 1 xyzq -1
list [teststringobj length 1] [teststringobj length2 1] \
[teststringobj get 1]
-} {10 20 abcdefxyzq}
+} {10 10 abcdefxyzq}
test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} testobj {
testobj freeallvars
testobj newobj 1
@@ -97,7 +97,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 fullutf} {
testobj freeallvars
teststringobj set 1 xyz
teststringobj setlength 1 15
@@ -109,7 +109,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,12 +135,12 @@ 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 fullutf} {
testobj freeallvars
testobj newobj 1
teststringobj appendstrings 1 123 abcdefg
list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
-} {10 20 123abcdefg}
+} {10 10 123abcdefg}
test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
testobj freeallvars
teststringobj set 1 abc
@@ -150,7 +150,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 fullutf} {
testobj freeallvars
teststringobj set 1 abc
teststringobj setlength 1 10
@@ -158,7 +158,7 @@ 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}
+} {11 11 ab34567890x}
test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj {
testobj freeallvars
testobj newobj 1
@@ -172,13 +172,13 @@ 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 fullutf} {
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}}
+} {4 4 {a bx}}
test stringObj-7.2 {SetStringFromAny procedure, null object} testobj {
testobj freeallvars
testobj newobj 1
@@ -197,7 +197,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 fullutf} {
testobj freeallvars
teststringobj set 1 {}
teststringobj append 1 abcde -1
@@ -206,7 +206,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
diff --git a/win/rules.vc b/win/rules.vc
index 6d9bbf8..3107756 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -1470,8 +1470,8 @@ cdebug = $(cdebug) -Zi
!endif # $(DEBUG)
-# cwarn includes default warning levels.
-cwarn = $(WARNINGS)
+# cwarn includes default warning levels, also C4146 is useless.
+cwarn = $(WARNINGS) -wd4146
!if "$(MACHINE)" == "AMD64" || "$(MACHINE)" == "ARM64"
# Disable pointer<->int warnings related to cast between different sizes
generated by cgit v0.12 at 2025-09-06 23:03:48 (GMT)