diff options
author | dgp <dgp@users.sourceforge.net> | 2012-01-26 16:15:29 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2012-01-26 16:15:29 (GMT) |
commit | 60eb1e2cb5c0b229f7accc83107f616fc504f38a (patch) | |
tree | a07c8d78bc4921d1a86a5e1de5e19f5d65f5dc25 | |
parent | a1a806f280075c02c755f1a453ca462c0db71ce1 (diff) | |
parent | 4e5840745fe8bd929f716debb48a26d381fd8023 (diff) | |
download | tcl-60eb1e2cb5c0b229f7accc83107f616fc504f38a.zip tcl-60eb1e2cb5c0b229f7accc83107f616fc504f38a.tar.gz tcl-60eb1e2cb5c0b229f7accc83107f616fc504f38a.tar.bz2 |
merge to bugfix
-rw-r--r-- | generic/tclCmdMZ.c | 7 | ||||
-rw-r--r-- | generic/tclObj.c | 6 | ||||
-rw-r--r-- | tests/stringObj.test | 65 |
3 files changed, 50 insertions, 28 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ab673d5..aed0022 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -264,8 +264,11 @@ Tcl_RegexpObjCmd( * start of the string unless the previous character is a newline. */ - if ((offset == 0) || ((offset > 0) && (offset < stringLength) && - (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n'))) { + if (offset == 0) { + eflags = 0; + } else if (offset > stringLength) { + eflags = TCL_REG_NOTBOL; + } else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') { eflags = 0; } else { eflags = TCL_REG_NOTBOL; diff --git a/generic/tclObj.c b/generic/tclObj.c index 5c17df2..a30ba6e 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -384,6 +384,9 @@ typedef struct ResolvedCmdName { void TclInitObjSubsystem(void) { + ObjInitDeletionContext(context); + ObjDeletionLock(context); + Tcl_MutexLock(&tableMutex); typeTableInitialized = 1; Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS); @@ -485,6 +488,9 @@ TclFinalizeThreadObjects(void) void TclFinalizeObjects(void) { + ObjInitDeletionContext(context); + ObjDeletionUnlock(context); + Tcl_MutexLock(&tableMutex); if (typeTableInitialized) { Tcl_DeleteHashTable(&typeTable); diff --git a/tests/stringObj.test b/tests/stringObj.test index 1ab3a48..3b25592 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -18,6 +18,7 @@ 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] @@ -229,13 +230,15 @@ 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} + [set y] [testobj objtype $x] [testobj objtype $y] +} "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 string length $x @@ -244,19 +247,23 @@ test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj { } {string abcï¿®ghiabcï¿®ghi string\ abcï¿®ghiabcï¿®ghiabcï¿®ghiabcï¿®ghi\ string} -test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} testobj { +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 { + [set y] [testobj objtype $x] [testobj objtype $y] +} "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] + [set y] [testobj objtype $x] [testobj objtype $y] } {string none abcdefghijkl jkl string none} test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj { set x abcdefghi @@ -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} + [set y] [testobj objtype $x] [testobj objtype $y] +} "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}] @@ -316,20 +325,24 @@ test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} tes set q } {a b c d e f a ü b å c ï} -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] + [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] + [testobj objtype $x] [testobj objtype $y] } [list none "bc\u00EF\u00EFde" string string] test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj { # set x "abcïïdef" |