summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhershey <hershey>1999-06-15 03:14:44 (GMT)
committerhershey <hershey>1999-06-15 03:14:44 (GMT)
commit341ee3ff2ace23473a603c34c20809c1e8e2f1d4 (patch)
tree8ae3354a682760e414bd6306868fc7b8535ff9bd
parent73d440a8ed4e3ef4fd1c30ce5708061a261396dc (diff)
downloadtcl-341ee3ff2ace23473a603c34c20809c1e8e2f1d4.zip
tcl-341ee3ff2ace23473a603c34c20809c1e8e2f1d4.tar.gz
tcl-341ee3ff2ace23473a603c34c20809c1e8e2f1d4.tar.bz2
Improved the appendObj functions (uncomented the optimized code that was
present in the Unicode obj). Updated the teststringobj command to look in the correct location for the amount of space allocated for the UTF string rep. Note: one stringObj test is still failing; it reflects a change in that may not be undesirable...
-rw-r--r--generic/tclStringObj.c38
-rw-r--r--generic/tclTestObj.c21
-rw-r--r--tests/stringObj.test177
3 files changed, 106 insertions, 130 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 8dc6e90..09cfc4c 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -31,7 +31,7 @@ A Unicode string
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStringObj.c,v 1.8 1999/06/15 01:16:25 hershey Exp $
+ * RCS: @(#) $Id: tclStringObj.c,v 1.9 1999/06/15 03:14:44 hershey Exp $
*/
#include "tclInt.h"
@@ -793,31 +793,18 @@ Tcl_AppendToObj(objPtr, bytes, length)
}
/*
- * TEMPORARY!!! This is terribly inefficient, but it works, and Don
- * needs for me to check this stuff in ASAP. -Melissa
- */
-
-/* printf("called Tcl_AppendToObj with str = %s\n", bytes); */
- UpdateStringOfString(objPtr);
- AppendUtfToUtfRep(objPtr, bytes, length);
- return;
-
- /*
* If objPtr has a valid Unicode rep, then append the Unicode
* conversion of "bytes" to the objPtr's Unicode rep, otherwise
* append "bytes" to objPtr's string rep.
*/
stringPtr = GET_STRING(objPtr);
- if (stringPtr->allocated > 0) {
+ if (stringPtr->uallocated > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, length);
stringPtr = GET_STRING(objPtr);
-/* printf(" ended Tcl_AppendToObj with %d unicode chars.\n", */
-/* stringPtr->numChars); */
} else {
AppendUtfToUtfRep(objPtr, bytes, length);
-/* printf(" ended Tcl_AppendToObj with str = %s\n", objPtr->bytes); */
}
}
@@ -862,9 +849,9 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length)
* needs for me to check this stuff in ASAP. -Melissa
*/
- UpdateStringOfString(objPtr);
- AppendUnicodeToUtfRep(objPtr, unicode, length);
- return;
+/* UpdateStringOfString(objPtr); */
+/* AppendUnicodeToUtfRep(objPtr, unicode, length); */
+/* return; */
/*
* If objPtr has a valid Unicode rep, then append the "unicode"
@@ -873,7 +860,7 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length)
*/
stringPtr = GET_STRING(objPtr);
- if (stringPtr->allocated > 0) {
+ if (stringPtr->uallocated > 0) {
AppendUnicodeToUnicodeRep(objPtr, unicode, length);
} else {
AppendUnicodeToUtfRep(objPtr, unicode, length);
@@ -910,22 +897,12 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr)
SetStringFromAny(NULL, objPtr);
/*
- * TEMPORARY!!! This is terribly inefficient, but it works, and Don
- * needs for me to check this stuff in ASAP. -Melissa
- */
-
- UpdateStringOfString(objPtr);
- bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
- AppendUtfToUtfRep(objPtr, bytes, length);
- return;
-
- /*
* If objPtr has a valid Unicode rep, then get a Unicode string
* from appendObjPtr and append it.
*/
stringPtr = GET_STRING(objPtr);
- if (stringPtr->allocated > 0) {
+ if (stringPtr->uallocated > 0) {
/*
* If appendObjPtr is not of the "String" type, don't convert it.
@@ -1047,7 +1024,6 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
int numChars; /* Number of chars of "unicode" to convert. */
{
Tcl_DString dsPtr;
- int length = numChars * sizeof(Tcl_UniChar);
char *bytes;
if (numChars == 0) {
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 533b967..259fcbd 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTestObj.c,v 1.4 1999/06/08 02:59:26 hershey Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.5 1999/06/15 03:14:45 hershey Exp $
*/
#include "tclInt.h"
@@ -58,6 +58,14 @@ static int TestobjCmd _ANSI_ARGS_((ClientData dummy,
static int TeststringobjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+
+typedef struct TestString {
+ int numChars;
+ size_t allocated;
+ size_t uallocated;
+ Tcl_UniChar unicode[2];
+} TestString;
+
/*
*----------------------------------------------------------------------
@@ -872,6 +880,7 @@ TeststringobjCmd(clientData, interp, objc, objv)
int varIndex, option, i, length;
#define MAX_STRINGS 11
char *index, *string, *strings[MAX_STRINGS+1];
+ TestString *strPtr;
static char *options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
"set", "set2", "setlength", (char *) NULL
@@ -974,8 +983,14 @@ TeststringobjCmd(clientData, interp, objc, objv)
if (objc != 3) {
goto wrongNumArgs;
}
- Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
- ? (int) varPtr[varIndex]->internalRep.longValue : -1);
+ if (varPtr[varIndex] != NULL) {
+ strPtr = (TestString *)
+ (varPtr[varIndex])->internalRep.otherValuePtr;
+ length = (int) strPtr->allocated;
+ } else {
+ length = -1;
+ }
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
break;
case 6: /* set */
if (objc != 4) {
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 9b72e94..49af6e4 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: stringObj.test,v 1.4 1999/06/15 01:16:27 hershey Exp $
+# RCS: @(#) $Id: stringObj.test,v 1.5 1999/06/15 03:22:31 hershey Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -189,100 +189,28 @@ test stringObj-8.1 {DupStringInternalRep procedure} {
[teststringobj length 2] [teststringobj length2 2] \
[teststringobj get 2]
} {5 10 5 5 abcde}
-
-test unicode-1.1 {TclGetUniCharFromObj with byte-size chars} {
- string index "abcdefghi" 0
-} "a"
-test unicode-1.2 {TclGetUniCharFromObj with byte-size chars} {
- string index "abcdefghi" 3
-} "d"
-test unicode-1.3 {TclGetUniCharFromObj with byte-size chars} {
- string index "abcdefghi" end
-} "i"
-test unicode-1.4 {TclGetUniCharFromObj with mixed width chars} {
- string index "ïa¿b®c®¿dï" 0
-} "ï"
-test unicode-1.5 {TclGetUniCharFromObj} {
- string index "ïa¿b®c®¿dï" 4
-} "®"
-test unicode-1.6 {TclGetUniCharFromObj} {
- string index "ïa¿b®cï¿d®" end
-} "®"
-
-test unicode-2.1 {TclGetUnicodeLengthFromObj with byte-size chars} {
- string length ""
-} 0
-test unicode-2.2 {TclGetUnicodeLengthFromObj with byte-size chars} {
- string length "a"
-} 1
-test unicode-2.3 {TclGetUnicodeLengthFromObj with byte-size chars} {
- string length "abcdef"
-} 6
-test unicode-2.4 {TclGetUnicodeLengthFromObj with mixed width chars} {
- string length "®"
-} 1
-test unicode-2.5 {TclGetUnicodeLengthFromObj with mixed width chars} {
- string length "○○"
-} 6
-test unicode-2.6 {TclGetUnicodeLengthFromObj with mixed width chars} {
- string length "ïa¿b®cï¿d®"
-} 10
-
-test unicode-3.1 {TclGetRangeFromObj with all byte-size chars} {testobj} {
- set x "abcdef"
- list [testobj objtype $x] [set y [string range $x 1 end-1]] \
- [testobj objtype $x] [testobj objtype $y]
-} {none bcde string none}
-
-test unicode-3.2 {TclGetRangeFromObj with some mixed width chars} {testobj} {
- set x "abcïïdef"
- list [testobj objtype $x] [set y [string range $x 1 end-1]] \
- [testobj objtype $x] [testobj objtype $y]
-} {none bcïïde string string}
-
-test unicode-4.1 {UpdateStringOfUnicode} {testobj} {
- set x 2345
- list [string index $x end] [testobj objtype $x] [incr x] \
- [testobj objtype $x]
-} {5 string 2346 int}
-
-test unicode-5.1 {SetUnicodeFromAny called with non-unicode obj} {testobj} {
- set x 2345
- list [incr x] [testobj objtype $x] [string index $x end] \
- [testobj objtype $x]
-} {2346 int 6 string}
-
-test unicode-5.2 {SetUnicodeFromAny called with unicode obj} {testobj} {
- set x "abcdef"
- list [string length $x] [testobj objtype $x] \
- [string length $x] [testobj objtype $x]
-} {6 string 6 string}
-
-test unicode-6.1 {DupUnicodeInternalRep, mixed width chars} {testobj} {
+test string-8.2 {DupUnicodeInternalRep, mixed width chars} {testobj} {
set x abcï¿®ghi
string length $x
set y $x
list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
-
-test unicode-6.2 {DupUnicodeInternalRep, mixed width chars} {testobj} {
+test string-8.3 {DupUnicodeInternalRep, mixed width chars} {testobj} {
set x abcï¿®ghi
set y $x
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
-
-test unicode-6.3 {DupUnicodeInternalRep, all byte-size chars} {testobj} {
+test string-8.4 {DupUnicodeInternalRep, all byte-size chars} {testobj} {
set x abcdefghi
string length $x
set y $x
list [testobj objtype $x] [testobj objtype $y] [append x jkl] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcdefghijkl abcdefghi string string}
-
-test unicode-6.4 {DupUnicodeInternalRep, all byte-size chars} {testobj} {
+test string-8.5 {DupUnicodeInternalRep, all byte-size chars} {testobj} {
set x abcdefghi
set y $x
string length $x
@@ -290,15 +218,14 @@ test unicode-6.4 {DupUnicodeInternalRep, all byte-size chars} {testobj} {
[set y] [testobj objtype $x] [testobj objtype $y]
} {string string abcdefghijkl abcdefghi string string}
-test unicode-7.1 {TclAppendObjToUnicodeObj, mixed src & dest} {testobj} {
+test string-9.1 {TclAppendObjToObj, mixed src & dest} {testobj} {
set x abcï¿®ghi
set y ®¿ï
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 string}
-
-test unicode-7.2 {TclAppendObjToUnicodeObj, mixed src & dest} {testobj} {
+test string-9.2 {TclAppendObjToObj, mixed src & dest} {testobj} {
set x abcï¿®ghi
string length $x
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
@@ -306,62 +233,54 @@ test unicode-7.2 {TclAppendObjToUnicodeObj, mixed src & dest} {testobj} {
} {string abcï¿®ghiabcï¿®ghi string\
abcï¿®ghiabcï¿®ghiabcï¿®ghiabcï¿®ghi\
string}
-
-test unicode-7.3 {TclAppendObjToUnicodeObj, mixed src & 1-byte dest} {testobj} {
+test string-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj} {
set x abcdefghi
set y ®¿ï
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 string}
-
-test unicode-7.4 {TclAppendObjToUnicodeObj, 1-byte src & dest} {testobj} {
+test string-9.4 {TclAppendObjToObj, 1-byte src & dest} {testobj} {
set x abcdefghi
set y jkl
string length $x
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[set y] [testobj objtype $x] [testobj objtype $y]
} {string none abcdefghijkl jkl string string}
-
-test unicode-7.5 {TclAppendObjToUnicodeObj, 1-byte src & dest} {testobj} {
+test string-9.5 {TclAppendObjToObj, 1-byte src & dest} {testobj} {
set x abcdefghi
string length $x
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
[append x $x] [testobj objtype $x]
} {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\
string}
-
-test unicode-7.6 {TclAppendObjToUnicodeObj, 1-byte src & mixed dest} {testobj} {
+test string-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {testobj} {
set x abcï¿®ghi
set y jkl
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 string}
-
-test unicode-7.7 {TclAppendObjToUnicodeObj, integer src & dest} {testobj} {
+test string-9.7 {TclAppendObjToObj, integer src & dest} {testobj} {
set x [expr {4 * 5}]
set y [expr {4 + 5}]
list [testobj objtype $x] [testobj objtype $y] [append x $y] \
[testobj objtype $x] [append x $y] [testobj objtype $x] \
[testobj objtype $y]
} {int int 209 string 2099 string int}
-
-test unicode-7.8 {TclAppendObjToUnicodeObj, integer src & dest} {testobj} {
+test string-9.8 {TclAppendObjToObj, integer src & dest} {testobj} {
set x [expr {4 * 5}]
list [testobj objtype $x] [append x $x] [testobj objtype $x] \
[append x $x] [testobj objtype $x]
} {int 2020 string 20202020 string}
-
-test unicode-7.9 {TclAppendObjToUnicodeObj, integer src & 1-byte dest} {testobj} {
+test string-9.9 {TclAppendObjToObj, integer src & 1-byte dest} {testobj} {
set x abcdefghi
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 abcdefghi9 9 string int}
-
-test unicode-7.10 {TclAppendObjToUnicodeObj, integer src & mixed dest} {testobj} {
+test string-9.10 {TclAppendObjToObj, integer src & mixed dest} {testobj} {
set x abcï¿®ghi
set y [expr {4 + 5}]
string length $x
@@ -369,6 +288,72 @@ test unicode-7.10 {TclAppendObjToUnicodeObj, integer src & mixed dest} {testobj}
[set y] [testobj objtype $x] [testobj objtype $y]
} {string int abcï¿®ghi9 9 string int}
+test string-10.1 {SetStringFromAny called with non-string obj} {testobj} {
+ set x 2345
+ list [incr x] [testobj objtype $x] [string index $x end] \
+ [testobj objtype $x]
+} {2346 int 6 string}
+test string-10.2 {SetStringFromAny called with string obj} {testobj} {
+ set x "abcdef"
+ list [string length $x] [testobj objtype $x] \
+ [string length $x] [testobj objtype $x]
+} {6 string 6 string}
+
+test string-11.1 {UpdateStringOfString} {testobj} {
+ set x 2345
+ list [string index $x end] [testobj objtype $x] [incr x] \
+ [testobj objtype $x]
+} {5 string 2346 int}
+
+test string-12.1 {TclGetUniCharFromObj with byte-size chars} {
+ string index "abcdefghi" 0
+} "a"
+test string-12.2 {TclGetUniCharFromObj with byte-size chars} {
+ string index "abcdefghi" 3
+} "d"
+test string-12.3 {TclGetUniCharFromObj with byte-size chars} {
+ string index "abcdefghi" end
+} "i"
+test string-12.4 {TclGetUniCharFromObj with mixed width chars} {
+ string index "ïa¿b®c®¿dï" 0
+} "ï"
+test string-12.5 {TclGetUniCharFromObj} {
+ string index "ïa¿b®c®¿dï" 4
+} "®"
+test string-12.6 {TclGetUniCharFromObj} {
+ string index "ïa¿b®cï¿d®" end
+} "®"
+
+test string-13.1 {TclGetUnicodeLengthFromObj with byte-size chars} {
+ string length ""
+} 0
+test string-13.2 {TclGetUnicodeLengthFromObj with byte-size chars} {
+ string length "a"
+} 1
+test string-13.3 {TclGetUnicodeLengthFromObj with byte-size chars} {
+ string length "abcdef"
+} 6
+test string-13.4 {TclGetUnicodeLengthFromObj with mixed width chars} {
+ string length "®"
+} 1
+test string-13.5 {TclGetUnicodeLengthFromObj with mixed width chars} {
+ string length "○○"
+} 6
+test string-13.6 {TclGetUnicodeLengthFromObj with mixed width chars} {
+ string length "ïa¿b®cï¿d®"
+} 10
+
+test string-14.1 {TclGetRangeFromObj with all byte-size chars} {testobj} {
+ set x "abcdef"
+ list [testobj objtype $x] [set y [string range $x 1 end-1]] \
+ [testobj objtype $x] [testobj objtype $y]
+} {none bcde string none}
+test string-14.2 {TclGetRangeFromObj with some mixed width chars} {testobj} {
+ set x "abcïïdef"
+ list [testobj objtype $x] [set y [string range $x 1 end-1]] \
+ [testobj objtype $x] [testobj objtype $y]
+} {none bcïïde string string}
+
testobj freeallvars
# cleanup