From e760092378d4b34b2f4cbd66a613128dbd703258 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Jun 2017 16:44:51 +0000 Subject: When possible delay string rep generation until necessary. --- generic/tclStringObj.c | 56 +++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 46 insertions(+), 10 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index aae52ba..be71109 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2847,7 +2847,7 @@ TclStringCatObjv( Tcl_Obj * const objv[], Tcl_Obj **objPtrPtr) { - Tcl_Obj *objPtr, *objResultPtr, * const *ov; + Tcl_Obj *objPtr, *objResultPtr, * const *ov, *pendingPtr = NULL; int oc, length = 0, binary = 1, first = 0, last = 0; int allowUniChar = 1, requestUniChar = 0; @@ -2952,14 +2952,37 @@ TclStringCatObjv( objPtr = *ov++; - Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ - if (numBytes) { + if ((length == 0) && (objPtr->bytes == NULL) && !pendingPtr) { + /* No string rep; Take the chance we can avoid making it */ + last = objc - oc; - if (length == 0) { - first = last; - } - if ((length += numBytes) < 0) { - goto overflow; + first = last; + pendingPtr = objPtr; + } else { + + Tcl_GetStringFromObj(objPtr, &numBytes);/* PANIC? */ + if (numBytes) { + last = objc - oc; + if (length == 0) { + if (pendingPtr) { + int pendingNumBytes; + + Tcl_GetStringFromObj(pendingPtr, &pendingNumBytes); /* PANIC? */ + if (pendingNumBytes) { + if ((length += pendingNumBytes) < 0) { + goto overflow; + } + } else { + first = last; + } + pendingPtr = NULL; + } else { + first = last; + } + } + if ((length += numBytes) < 0) { + goto overflow; + } } } } while (--oc); @@ -3056,13 +3079,18 @@ TclStringCatObjv( } else { /* Efficiently concatenate string reps */ char *dst; + int start; if (inPlace && !Tcl_IsShared(*objv)) { - int start; - objResultPtr = *objv++; objc--; Tcl_GetStringFromObj(objResultPtr, &start); + if (pendingPtr) { + /* assert ( pendingPtr == objResultPtr ) */ + if ((length += start) < 0) { + goto overflow; + } + } if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3075,8 +3103,16 @@ TclStringCatObjv( dst = Tcl_GetString(objResultPtr) + start; if (length > start) { TclFreeIntRep(objResultPtr); + } else { + /* Can't happen ? */ } } else { + if (pendingPtr) { + Tcl_GetStringFromObj(pendingPtr, &start); + if ((length += start) < 0) { + goto overflow; + } + } objResultPtr = Tcl_NewObj(); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { -- cgit v0.12 From 5640f7a50784a038ff4a2d97550a103286352a10 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Jun 2017 19:35:05 +0000 Subject: Tests for string rep generation suppression --- tests/string.test | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/tests/string.test b/tests/string.test index fa7f8fb..9c43f29 100644 --- a/tests/string.test +++ b/tests/string.test @@ -1994,6 +1994,36 @@ test string-29.4 {string cat, many args} { set r2 [string compare $xx [eval "string cat $vvs"]] list $r1 $r2 } {0 0} +test string-29.5 {string cat, efficiency} -body { + tcl::unsupported::representation [string cat [list x] [list]] +} -match glob -result {*no string representation} +test string-29.6 {string cat, efficiency} -body { + tcl::unsupported::representation [string cat [list] [list x]] +} -match glob -result {*no string representation} +test string-29.7 {string cat, efficiency} -body { + tcl::unsupported::representation [string cat [list x] [list] [list]] +} -match glob -result {*no string representation} +test string-29.8 {string cat, efficiency} -body { + tcl::unsupported::representation [string cat [list] [list x] [list]] +} -match glob -result {*no string representation} +test string-29.9 {string cat, efficiency} -body { + tcl::unsupported::representation [string cat [list] [list] [list x]] +} -match glob -result {*no string representation} +test string-29.10 {string cat, efficiency} -body { + tcl::unsupported::representation [string cat [list x] [list x]] +} -match glob -result {*, string representation "xx"} +test string-29.11 {string cat, efficiency} -body { + tcl::unsupported::representation \ + [string cat [list x] [encoding convertto utf-8 {}]] +} -match glob -result {*no string representation} +test string-29.12 {string cat, efficiency} -body { + tcl::unsupported::representation \ + [string cat [encoding convertto utf-8 {}] [list x]] +} -match glob -result {*, string representation "x"} +test string-29.13 {string cat, efficiency} -body { + tcl::unsupported::representation [string cat \ + [encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]] +} -match glob -result {*, string representation "x"} -- cgit v0.12 From 1a49b000a0d9e7c09366f62d7ccbc904a45b6b68 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Jun 2017 20:31:47 +0000 Subject: pendingPtr == NULL implies (last == first) implies early out --- generic/tclStringObj.c | 17 +++-------------- 1 file changed, 3 insertions(+), 14 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index be71109..847182d 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2847,7 +2847,7 @@ TclStringCatObjv( Tcl_Obj * const objv[], Tcl_Obj **objPtrPtr) { - Tcl_Obj *objPtr, *objResultPtr, * const *ov, *pendingPtr = NULL; + Tcl_Obj *objPtr, *objResultPtr, * const *ov; int oc, length = 0, binary = 1, first = 0, last = 0; int allowUniChar = 1, requestUniChar = 0; @@ -2945,6 +2945,8 @@ TclStringCatObjv( } } while (--oc); } else { + Tcl_Obj *pendingPtr = NULL; + /* Result will be concat of string reps. Pre-size it. */ ov = objv; oc = objc; do { @@ -2975,7 +2977,6 @@ TclStringCatObjv( } else { first = last; } - pendingPtr = NULL; } else { first = last; } @@ -3085,12 +3086,6 @@ TclStringCatObjv( objResultPtr = *objv++; objc--; Tcl_GetStringFromObj(objResultPtr, &start); - if (pendingPtr) { - /* assert ( pendingPtr == objResultPtr ) */ - if ((length += start) < 0) { - goto overflow; - } - } if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3107,12 +3102,6 @@ TclStringCatObjv( /* Can't happen ? */ } } else { - if (pendingPtr) { - Tcl_GetStringFromObj(pendingPtr, &start); - if ((length += start) < 0) { - goto overflow; - } - } objResultPtr = Tcl_NewObj(); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { -- cgit v0.12 From b0e8c40cebd7999b6ccf308dbf0ebb8e3be0ab0b Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Jun 2017 20:40:45 +0000 Subject: More streamlining. --- generic/tclStringObj.c | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 847182d..c4d07e0 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2967,17 +2967,9 @@ TclStringCatObjv( last = objc - oc; if (length == 0) { if (pendingPtr) { - int pendingNumBytes; - - Tcl_GetStringFromObj(pendingPtr, &pendingNumBytes); /* PANIC? */ - if (pendingNumBytes) { - if ((length += pendingNumBytes) < 0) { - goto overflow; - } - } else { - first = last; - } - } else { + Tcl_GetStringFromObj(pendingPtr, &length); /* PANIC? */ + } + if (length == 0) { first = last; } } @@ -3080,9 +3072,10 @@ TclStringCatObjv( } else { /* Efficiently concatenate string reps */ char *dst; - int start; if (inPlace && !Tcl_IsShared(*objv)) { + int start; + objResultPtr = *objv++; objc--; Tcl_GetStringFromObj(objResultPtr, &start); -- cgit v0.12 From e787f0ec1254d077093819ab5d08680448a0b217 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Jun 2017 20:57:06 +0000 Subject: More streamlining --- generic/tclStringObj.c | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c4d07e0..31a6b26 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2962,20 +2962,20 @@ TclStringCatObjv( pendingPtr = objPtr; } else { - Tcl_GetStringFromObj(objPtr, &numBytes);/* PANIC? */ - if (numBytes) { - last = objc - oc; - if (length == 0) { - if (pendingPtr) { - Tcl_GetStringFromObj(pendingPtr, &length); /* PANIC? */ - } - if (length == 0) { - first = last; - } - } - if ((length += numBytes) < 0) { - goto overflow; - } + Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ + if (numBytes == 0) { + continue; + } + last = objc - oc; + if (pendingPtr) { + Tcl_GetStringFromObj(pendingPtr, &length); /* PANIC? */ + pendingPtr = NULL; + } + if (length == 0) { + first = last; + } + if ((length += numBytes) < 0) { + goto overflow; } } } while (--oc); -- cgit v0.12 From 7c926553f6dcae359d48cc16d1ace1291a5dfb4b Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Jun 2017 21:05:22 +0000 Subject: Modernize overflow checks. --- generic/tclStringObj.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 31a6b26..43f8016 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2916,10 +2916,10 @@ TclStringCatObjv( last = objc - oc; if (length == 0) { first = last; - } - if ((length += numBytes) < 0) { + } else if (numBytes > INT_MAX - length) { goto overflow; } + length += numBytes; } } } while (--oc); @@ -2937,10 +2937,10 @@ TclStringCatObjv( last = objc - oc; if (length == 0) { first = last; - } - if ((length += numChars) < 0) { + } else if (numChars > INT_MAX - length) { goto overflow; } + length += numChars; } } } while (--oc); @@ -2973,10 +2973,10 @@ TclStringCatObjv( } if (length == 0) { first = last; - } - if ((length += numBytes) < 0) { + } else if (numBytes > INT_MAX - length) { goto overflow; } + length += numBytes; } } while (--oc); } -- cgit v0.12 From d6fff27296f668ac9cb89dda2fc6732634c19424 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Jun 2017 21:10:01 +0000 Subject: Don't test the impossible. --- generic/tclStringObj.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 43f8016..aa99545 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3089,11 +3089,9 @@ TclStringCatObjv( return TCL_ERROR; } dst = Tcl_GetString(objResultPtr) + start; - if (length > start) { - TclFreeIntRep(objResultPtr); - } else { - /* Can't happen ? */ - } + + /* assert ( length > start ) */ + TclFreeIntRep(objResultPtr); } else { objResultPtr = Tcl_NewObj(); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { -- cgit v0.12