diff options
-rw-r--r-- | jim.c | 8 | ||||
-rw-r--r-- | regtest.tcl | 13 | ||||
-rw-r--r-- | tests/upvar.test | 5 |
3 files changed, 26 insertions, 0 deletions
@@ -4066,6 +4066,14 @@ int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr, } Jim_IncrRefCount(targetNameObjPtr); + if (framePtr->level < targetCallFrame->level) { + Jim_SetResultFormatted(interp, + "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable", + nameObjPtr); + Jim_DecrRefCount(interp, targetNameObjPtr); + return JIM_ERR; + } + /* Check for cycles. */ if (framePtr == targetCallFrame) { Jim_Obj *objPtr = targetNameObjPtr; diff --git a/regtest.tcl b/regtest.tcl index 999d4b0..0f2e5b6 100644 --- a/regtest.tcl +++ b/regtest.tcl @@ -165,6 +165,19 @@ set t 6 catch a puts "TEST 24 PASSED" +# REGTEST 25 +# 14 Nov 2011 - link global var to proc var +proc a {} { + set x 3 + upvar 0 x ::globx +} +set globx 0 +catch { + a +} +incr globx +puts "TEST 25 PASSED" + # TAKE THE FOLLOWING puts AS LAST LINE puts "--- ALL TESTS PASSED ---" diff --git a/tests/upvar.test b/tests/upvar.test index 4b919a2..8d95c1d 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -340,6 +340,11 @@ test upvar-9.6 {upvar via global namespace} { list [catch p1 msg] $msg } {1 {can't upvar from variable to itself}} +test upvar-9.7 {upvar to higher level} { + proc p1 {} { upvar 0 x ::globx } + list [catch p1 msg] $msg +} {1 {bad variable name "::globx": upvar won't create namespace variable that refers to procedure variable}} + catch {unset a} testreport |