diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-01-11 15:45:20 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-01-11 15:45:20 (GMT) |
| commit | 244885a03e8d66f5500058eaf820d6b47f292007 (patch) | |
| tree | c05b91ecdda65e011cf8698d04b82936bdc03d37 | |
| parent | 48d6a20861f95be856bef0e780c054757c9c3803 (diff) | |
| parent | 45e646472daf2fe6beb41555fe088b929cd2ce6c (diff) | |
| download | tcl-244885a03e8d66f5500058eaf820d6b47f292007.zip tcl-244885a03e8d66f5500058eaf820d6b47f292007.tar.gz tcl-244885a03e8d66f5500058eaf820d6b47f292007.tar.bz2 | |
merge core-8-6-branch
| -rw-r--r-- | generic/tclStringObj.c | 13 | ||||
| -rw-r--r-- | tests/string.test | 4 |
2 files changed, 16 insertions, 1 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 385ce4f..ae75e44 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -522,7 +522,7 @@ Tcl_GetUniChar( * * Get the Unicode form of the String object. If the object is not * already a String object, it will be converted to one. If the String - * object does not have a Unicode rep, then one is create from the UTF + * object does not have a Unicode rep, then one is created from the UTF * string format. * * Results: @@ -656,6 +656,17 @@ Tcl_GetRange( stringPtr = GET_STRING(objPtr); } +#if TCL_UTF_MAX == 4 + /* See: bug [11ae2be95dac9417] */ + if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00) + && ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) { + ++first; + } + if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00) + && ((stringPtr->unicode[last]&0xFC00) == 0xD800)) { + ++last; + } +#endif return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1); } diff --git a/tests/string.test b/tests/string.test index cebaf4c..b75c900 100644 --- a/tests/string.test +++ b/tests/string.test @@ -24,6 +24,7 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [expr {[info commands testobj] != {}}] testConstraint testindexobj [expr {[info commands testindexobj] != {}}] +testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] @@ -1288,6 +1289,9 @@ test string-12.22 {string range, shimmering binary/index} { binary scan $s a* x string range $s $s end } 000000001 +test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} fullutf { + list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3] +} [list \U100000 {} b] test string-13.1 {string repeat} { list [catch {string repeat} msg] $msg |
