Attachment "dupes.patch" to
ticket [35fdc88036]
added by
mr_calvin
2017-02-23 12:53:27.
Index: generic/tclProc.c
==================================================================
--- generic/tclProc.c
+++ generic/tclProc.c
@@ -625,10 +625,34 @@
localPtr->flags |= VAR_IS_ARGS;
}
localPtr = localPtr->nextPtr;
} else {
+ const char *paramName = fieldValues[0];
+
+ /*
+ * Check for an existing entry having the same formal parameter
+ * name.
+ */
+#if 1
+ for (localPtr=procPtr->firstLocalPtr; localPtr != NULL;
+ localPtr=localPtr->nextPtr) {
+ if (TclIsVarArgument(localPtr) &&
+ (localPtr->nameLength == nameLength) &&
+ (localPtr->name[0] == *paramName) &&
+ (strcmp(localPtr->name, paramName) == 0)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "arg list contains a duplicate entry \"%s\"",
+ paramName));
+ ckfree(fieldValues);
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
+ "FORMALARGUMENTFORMAT", NULL);
+ goto procError;
+ }
+ }
+#endif
+
/*
* Allocate an entry in the runtime procedure frame's array of
* local variables for the argument.
*/
@@ -650,11 +674,11 @@
Tcl_NewStringObj(fieldValues[1], valueLength);
Tcl_IncrRefCount(localPtr->defValuePtr);
} else {
localPtr->defValuePtr = NULL;
}
- memcpy(localPtr->name, fieldValues[0], nameLength + 1);
+ memcpy(localPtr->name, paramName, nameLength + 1);
if ((i == numArgs - 1)
&& (localPtr->nameLength == 4)
&& (localPtr->name[0] == 'a')
&& (strcmp(localPtr->name, "args") == 0)) {
localPtr->flags |= VAR_IS_ARGS;
Index: tests/proc.test
==================================================================
--- tests/proc.test
+++ tests/proc.test
@@ -108,10 +108,52 @@
catch {rename p ""}
} -body {
proc p {b:a b::a} {
}
} -returnCodes error -result {formal parameter "b::a" is not a simple name}
+
+test proc-1.9 {Tcl_ProcObjCmd, check that formal parameter names are not repeated} -setup {
+ catch {rename p ""}
+} -body {
+ proc p {a a} {;}
+} -returnCodes error -result {arg list contains a duplicate entry "a"}
+
+test proc-1.10 {Tcl_ProcObjCmd, check that formal parameter names are not repeated (with defaults)} -setup {
+ catch {rename p ""}
+} -body {
+ proc p {{a 0} {a 1}} {;}
+} -returnCodes error -result {arg list contains a duplicate entry "a"}
+
+test proc-1.11 {Tcl_ProcObjCmd, check that formal parameter names are not repeated (args)} -setup {
+ catch {rename p ""}
+} -body {
+ proc p {args args} {;}
+} -returnCodes error -result {arg list contains a duplicate entry "args"}
+
+test proc-1.12 {Tcl_ProcObjCmd, check that formal parameter names are not repeated} -setup {
+ catch {rename p ""}
+} -body {
+ proc p {abc abc args args} {;}
+} -returnCodes error -result {arg list contains a duplicate entry "abc"}
+
+test proc-1.13 {Tcl_ProcObjCmd, check that formal parameter names are not repeated (interleaved)} -setup {
+ catch {rename p ""}
+} -body {
+ proc p {abc a b abc b} {;}
+} -returnCodes error -result {arg list contains a duplicate entry "abc"}
+
+test proc-1.14 {Tcl_ProcObjCmd, check that formal parameter names are not repeated (simple names)} -setup {
+ catch {rename p ""}
+} -body {
+ proc p {b:a b:a} {;}
+} -returnCodes error -result {arg list contains a duplicate entry "b:a"}
+
+test proc-1.15 {Tcl_ProcObjCmd, check that formal parameter names are not repeated (non-simple names)} -setup {
+ catch {rename p ""}
+} -body {
+ proc p {b::a b::a} {;}
+} -returnCodes error -result {formal parameter "b::a" is not a simple name}
test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
} -body {
Index: tests/trace.test
==================================================================
--- tests/trace.test
+++ tests/trace.test
@@ -2458,11 +2458,11 @@
# We test here for the half-documented and currently valid interplay between
# delete traces and namespace deletion.
test trace-34.4 {Bug 1047286} {
variable x notrace
- proc callback {old - -} {
+ proc callback {old - --} {
variable x "$old exists: [namespace which -command $old]"
}
namespace eval ::foo {proc bar {} {}}
trace add command ::foo::bar delete [namespace code callback]
namespace delete ::foo
@@ -2469,11 +2469,11 @@
set x
} {::foo::bar exists: ::foo::bar}
test trace-34.5 {Bug 1047286} {
variable x notrace
- proc callback {old - -} {
+ proc callback {old - --} {
variable x "$old exists: [namespace which -command $old]"
}
namespace eval ::foo {proc bar {} {}}
trace add command ::foo::bar delete [namespace code callback]
namespace eval ::foo namespace delete ::foo