diff options
| author | sbron <tclcore@tclcode.com> | 2022-08-24 11:53:24 (GMT) |
|---|---|---|
| committer | sbron <tclcore@tclcode.com> | 2022-08-24 11:53:24 (GMT) |
| commit | 66ebfaa06df00e3e2870e724a9e7adcb30d0a417 (patch) | |
| tree | b0701887bed74ccfdc876444b54c0afd5f12b215 | |
| parent | 10cc2ae8fdb18bd0408ff5d1a440cea2e85e55c4 (diff) | |
| download | tcl-66ebfaa06df00e3e2870e724a9e7adcb30d0a417.zip tcl-66ebfaa06df00e3e2870e724a9e7adcb30d0a417.tar.gz tcl-66ebfaa06df00e3e2870e724a9e7adcb30d0a417.tar.bz2 | |
Fix env array access through upvar to a single element.
| -rw-r--r-- | generic/tclEnv.c | 23 | ||||
| -rw-r--r-- | tests/env.test | 32 |
2 files changed, 53 insertions, 2 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 73a8b84..2c6f8e3 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -60,6 +60,10 @@ static struct { #define tNTL sizeof(techar) +/* Copied from tclVar.c - should possibly be moved to tclInt.h */ +#define VarHashGetKey(varPtr) \ + (((VarInHash *)(varPtr))->entry.key.objPtr) + /* * Declarations for local functions defined in this file: */ @@ -644,11 +648,26 @@ EnvTraceProc( } /* - * If name2 is NULL, then return and do nothing. + * When an env array element is accessed via an upvar reference, there + * are two possibilities: + * 1. The upvar references the complete array. In this case name1 may be + * something else than "env", but that doesn't affect anything. name2 + * will still be the correct name for the enviroment variable to use. + * 2. The upvar references a single element of the array. In this case + * name2 will be NULL and name1 is the name of the alias. This alias + * must be resolved to the actual key of the array element. */ if (name2 == NULL) { - return NULL; + Var *varPtr, *arrayPtr; + Tcl_Obj *name; + + name = Tcl_NewStringObj(name1, -1); + Tcl_IncrRefCount(name); + varPtr = TclObjLookupVarEx(interp, name, NULL, /*flags*/ 0, + /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); + Tcl_DecrRefCount(name); + name2 = Tcl_GetString(VarHashGetKey(varPtr)); } /* diff --git a/tests/env.test b/tests/env.test index 9eacd5d..30d8319 100644 --- a/tests/env.test +++ b/tests/env.test @@ -411,6 +411,38 @@ test env-7.3 { return [info exists ::env(test7_3)] }} } -cleanup cleanup1 -result 1 + +test env-7.4 { + get env variable through upvar +} -setup setup1 -body { + apply {{} { + set ::env(test7_4) origvalue + upvar #0 env(test7_4) var + return $var + }} +} -cleanup cleanup1 -result origvalue + +test env-7.5 { + set env variable through upvar +} -setup setup1 -body { + apply {{} { + set ::env(test7_4) origvalue + upvar #0 env(test7_4) var + set var newvalue + return $::env(test7_4) + }} +} -cleanup cleanup1 -result newvalue + +test env-7.6 { + unset env variable through upvar +} -setup setup1 -body { + apply {{} { + set ::env(test7_4) origvalue + upvar #0 env(test7_4) var + unset var + return [array get env test7_4] + }} +} -cleanup cleanup1 -result {} test env-8.0 { memory usage - valgrind does not report reachable memory |
