diff options
| -rw-r--r-- | generic/tclStringObj.c | 38 | ||||
| -rw-r--r-- | generic/tclTestObj.c | 21 | ||||
| -rw-r--r-- | tests/stringObj.test | 177 |
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 |