Tcl Source Code

Artifact fef460d801d5b3b4e1dd4dfaa5299da76efb2a5a:

Attachment "dupes.patch" to ticket [35fdc88036] added by mr_calvin 2017-02-23 12:53:27. (unpublished)

---

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