summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorsbron <tclcore@tclcode.com>2022-08-24 11:53:24 (GMT)
committersbron <tclcore@tclcode.com>2022-08-24 11:53:24 (GMT)
commit66ebfaa06df00e3e2870e724a9e7adcb30d0a417 (patch)
treeb0701887bed74ccfdc876444b54c0afd5f12b215
parent10cc2ae8fdb18bd0408ff5d1a440cea2e85e55c4 (diff)
downloadtcl-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.c23
-rw-r--r--tests/env.test32
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