fixes utf-8 compatibility of proc/lambda arguments (regression on compiled locals/variables containing utf-8 characters) - CompiledLocal::nameLength is length in bytes not in chars everywhere in tcl;

simplest example:
  % apply {{€} { set "€" }} 1; # or apply [list \u20ac { set \u20ac }] 1
  can't read "€": no such variable

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}