From 8a8e70d5a6a4db9ed214aa5d0b81bf0a63f910cd Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 30 Jan 2019 20:32:18 +0000 Subject: =?UTF-8?q?fixes=20utf-8=20compatibility=20of=20proc/lambda=20argu?= =?UTF-8?q?ments=20(regression=20on=20compiled=20locals/variables=20contai?= =?UTF-8?q?ning=20utf-8=20characters)=20-=20CompiledLocal::nameLength=20is?= =?UTF-8?q?=20length=20in=20bytes=20not=20in=20chars=20everywhere=20in=20t?= =?UTF-8?q?cl;=20simplest=20example:=20=20=20%=20apply=20{{=E2=82=AC}=20{?= =?UTF-8?q?=20set=20"=E2=82=AC"=20}}=201;=20#=20or=20apply=20[list=20\u20a?= =?UTF-8?q?c=20{=20set=20\u20ac=20}]=201=20=20=20can't=20read=20"=E2=82=AC?= =?UTF-8?q?":=20no=20such=20variable?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- generic/tclInt.h | 2 +- generic/tclProc.c | 25 +++++++++++-------------- tests/var.test | 22 ++++++++++++++++++++++ 3 files changed, 34 insertions(+), 15 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 0b67709..5b0206f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -902,7 +902,7 @@ typedef struct CompiledLocal { /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ - int nameLength; /* The number of characters in local + int nameLength; /* The number of bytes in local * variable's name. Used to speed up variable * lookups. */ int frameIndex; /* Index in the array of compiler-assigned diff --git a/generic/tclProc.c b/generic/tclProc.c index 533b817..f9869b8 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -474,7 +474,7 @@ TclCreateProc( } for (i = 0; i < numArgs; i++) { - int fieldCount, nameLength, valueLength; + int fieldCount, nameLength; Tcl_Obj **fieldValues; /* @@ -504,20 +504,14 @@ TclCreateProc( goto procError; } - argname = Tcl_GetStringFromObj(fieldValues[0], &plen); - nameLength = Tcl_NumUtfChars(argname, plen); - if (fieldCount == 2) { - const char * value = TclGetString(fieldValues[1]); - valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length); - } else { - valueLength = 0; - } + argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength); /* * Check that the formal parameter name is a scalar. */ argnamei = argname; + plen = nameLength; argnamelast = argname[plen-1]; while (plen--) { if (argnamei[0] == '(') { @@ -554,7 +548,7 @@ TclCreateProc( */ if ((localPtr->nameLength != nameLength) - || (Tcl_UtfNcmp(localPtr->name, argname, nameLength)) + || (memcmp(localPtr->name, argname, nameLength) != 0) || (localPtr->frameIndex != i) || !(localPtr->flags & VAR_ARGUMENT) || (localPtr->defValuePtr == NULL && fieldCount == 2) @@ -572,12 +566,15 @@ TclCreateProc( */ if (localPtr->defValuePtr != NULL) { - int tmpLength; + int tmpLength, valueLength; const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength); + const char *value = TclGetStringFromObj(fieldValues[1], + &valueLength); - if ((valueLength != tmpLength) || - Tcl_UtfNcmp(Tcl_GetString(fieldValues[1]), tmpPtr, tmpLength)) { + if ((valueLength != tmpLength) + || memcmp(value, tmpPtr, tmpLength) != 0 + ) { errorObj = Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"" ,procName); Tcl_AppendObjToObj(errorObj, fieldValues[0]); @@ -626,7 +623,7 @@ TclCreateProc( if ((i == numArgs - 1) && (localPtr->nameLength == 4) && (localPtr->name[0] == 'a') - && (strcmp(localPtr->name, "args") == 0)) { + && (memcmp(localPtr->name, "args", 4) == 0)) { localPtr->flags |= VAR_IS_ARGS; } } diff --git a/tests/var.test b/tests/var.test index 8d86fce..32388a2 100644 --- a/tests/var.test +++ b/tests/var.test @@ -201,6 +201,28 @@ test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: test var-1.19 {TclLookupVar, right error message when parsing variable name} -body { [format set] thisvar(doesntexist) } -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable} +test var-1.20 {TclLookupVar, regression on utf-8 variable names} -setup { + proc p [list \u20ac \xe4] {info vars} +} -body { + # test variable with non-ascii name is available (euro and a-uml chars here): + list \ + [p 1 2] \ + [apply [list [list \u20ac \xe4] {info vars}] 1 2] \ + [apply [list [list [list \u20ac \u20ac] [list \xe4 \xe4]] {info vars}]] \ +} -cleanup { + rename p {} +} -result [lrepeat 3 [list \u20ac \xe4]] +test var-1.21 {TclLookupVar, regression on utf-8 variable names} -setup { + proc p [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]} +} -body { + # test variable with non-ascii name (and default) is resolvable (euro and a-uml chars here): + list \ + [p] \ + [apply [list [list \u20ac \xe4] {list [set \u20ac] [set \xe4]}] v\u20ac v\xe4] \ + [apply [list [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]}]] \ +} -cleanup { + rename p {} +} -result [lrepeat 3 [list v\u20ac v\xe4]] test var-2.1 {Tcl_LappendObjCmd, create var if new} { catch {unset x} -- cgit v0.12