From 6127d0ae1c48c00e21584b66a79c21727291ca52 Mon Sep 17 00:00:00 2001
From: dah <dunnie@gmail.com>
Date: Sun, 18 Dec 2016 15:04:34 +0000
Subject: More tests, frame lookup tweak and attempt to take advantage of a
 branch prediction.

---
 generic/tclProc.c | 57 ++++++++++++++++++++++++++++---------------------------
 tests/proc.test   | 48 +++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 76 insertions(+), 29 deletions(-)

diff --git a/generic/tclProc.c b/generic/tclProc.c
index 49ca8eb..615515b 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -1596,15 +1596,22 @@ InitArgsAndLocals(
 
     int numArgVars = procPtr->numArgsCompiledLocals;
     if (numArgVars > numArgs) {
-        CallFrame *upFramePtr = NULL;
+        CallFrame *upFramePtr;
         Var *otherPtr, *arrayPtr;
 
+	/*
+         * If we got here, assume we'll be resolving links.
+         */
+
+	if (TclObjGetFrame(interp, NULL, &upFramePtr) == -1) {
+            i = -1;    /* Tell incorrectArgs we set the error */
+            goto incorrectArgs;
+        }
+
 	defPtr++;	/* Here, defPtr cannot be NULL */
 	for(i = numArgs; i < numArgVars; i++, varPtr++, defPtr++) {
-
             if (TclIsVarLink(defPtr)) {
 		int argIndex;
-		Tcl_Obj *objPtr;
 
 		/*
                  * Something went horribly wrong if this comes to a Panic.
@@ -1614,35 +1621,29 @@ InitArgsAndLocals(
 			&argIndex)) 
 			|| (argIndex < 0 || argIndex > numArgs - 1)) {
 		    Tcl_Panic("Link variable points to an invalid local index.");
-		}
-
-		objPtr = argObjs[argIndex];	
-                if (upFramePtr == NULL) {
-                    if (TclObjGetFrame(interp, NULL, &upFramePtr) == -1) {
+		} else {
+		    Tcl_Obj *objPtr = argObjs[argIndex];	
+
+                    /*
+                     * Locate the other variable.
+                     */
+
+                    ((Interp *)interp)->varFramePtr = upFramePtr;
+                    otherPtr = TclObjLookupVarEx(interp, objPtr, NULL,
+                            TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1,
+                            /*createPart2*/ 1, &arrayPtr);
+                    ((Interp *)interp)->varFramePtr = framePtr;
+                    if (otherPtr == NULL) {
                         i = -1;    /* Tell incorrectArgs we set the error */
                         goto incorrectArgs;
                     }
-                }
-
-                /*
-                 * Locate the other variable.
-                 */
 
-                ((Interp *)interp)->varFramePtr = upFramePtr;
-                otherPtr = TclObjLookupVarEx(interp, objPtr, NULL,
-                        TCL_LEAVE_ERR_MSG, "access", /*createPart1*/ 1,
-                        /*createPart2*/ 1, &arrayPtr);
-                ((Interp *)interp)->varFramePtr = framePtr;
-                if (otherPtr == NULL) {
-                    i = -1;	/* Tell incorrectArgs we set the error */
-                    goto incorrectArgs;
-                }
-
-                varPtr->flags = VAR_LINK;
-                varPtr->value.linkPtr = otherPtr;
-                if (TclIsVarInHash(otherPtr)) {
-                    VarHashRefCount(otherPtr)++;
-                }
+                    varPtr->flags = VAR_LINK;
+                    varPtr->value.linkPtr = otherPtr;
+                    if (TclIsVarInHash(otherPtr)) {
+                        VarHashRefCount(otherPtr)++;
+                    }
+		}
             }
         }
     }
diff --git a/tests/proc.test b/tests/proc.test
index 537c0ad..5658561 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -490,7 +490,7 @@ test proc-8.8 {Auto argument linking, default for auto-link formal} -body {
     }}
 } -constraints procbodytest -returnCodes error -cleanup {
     catch {rename P {}}
-} -result {procedure "P": formal parameter "*a"  is to be a link and can't have a default value}
+} -result {procedure "P": formal parameter "*a"  is to be linked and must not have a default value}
 
 test proc-8.9 {Auto argument linking, bad variable} -body {
     proc P {*a} {
@@ -501,6 +501,52 @@ test proc-8.9 {Auto argument linking, bad variable} -body {
     catch {rename P {}}
 } -result {can't access "mumbo::jumbo": parent namespace doesn't exist}
 
+test proc-8.10 {Auto argument linking, empty link name} -body {
+    proc P {*} {
+        incr {}
+    }
+    apply {{} {
+        P a
+        set a
+    }}
+} -cleanup {
+    rename P {}
+} -result {1}
+
+test proc-8.11 {Auto argument linking, link name consistency} -body {
+    proc P {**a} {
+        incr *a
+    }
+    apply {{} {
+        P a
+        set a
+    }}
+} -cleanup {
+    rename P {}
+} -result {1}
+
+test proc-8.12 {Auto argument linking, info args} -body {
+    proc P {*a b *c} {}
+    info args P
+} -cleanup {
+    rename P {}
+} -result {*a b *c}
+
+test proc-8.13 {Auto argument linking, info locals} -body {
+    proc P {*a b *c} {info locals}
+    P a b c
+} -cleanup {
+    rename P {}
+} -result {*a b *c}
+
+test proc-8.14 {Auto argument linking, linked arg retains value} -body {
+    proc P {*a} {set *a}
+    P a
+} -cleanup {
+    rename P {}
+} -result {a}
+
+
 
 # cleanup
 catch {rename p ""}
-- 
cgit v0.12