summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2012-01-26 16:15:29 (GMT)
committerdgp <dgp@users.sourceforge.net>2012-01-26 16:15:29 (GMT)
commit60eb1e2cb5c0b229f7accc83107f616fc504f38a (patch)
treea07c8d78bc4921d1a86a5e1de5e19f5d65f5dc25
parenta1a806f280075c02c755f1a453ca462c0db71ce1 (diff)
parent4e5840745fe8bd929f716debb48a26d381fd8023 (diff)
downloadtcl-60eb1e2cb5c0b229f7accc83107f616fc504f38a.zip
tcl-60eb1e2cb5c0b229f7accc83107f616fc504f38a.tar.gz
tcl-60eb1e2cb5c0b229f7accc83107f616fc504f38a.tar.bz2
merge to bugfix
-rw-r--r--generic/tclCmdMZ.c7
-rw-r--r--generic/tclObj.c6
-rw-r--r--tests/stringObj.test65
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"