From 66ebfaa06df00e3e2870e724a9e7adcb30d0a417 Mon Sep 17 00:00:00 2001
From: sbron <tclcore@tclcode.com>
Date: Wed, 24 Aug 2022 11:53:24 +0000
Subject: Fix env array access through upvar to a single element.

---
 generic/tclEnv.c | 23 +++++++++++++++++++++--
 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
-- 
cgit v0.12