summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-02-23 13:59:49 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-02-23 13:59:49 (GMT)
commit42a533ea114536fc5140078428fa7714bbe3c504 (patch)
treee86dee07e46ac7dcdd7442925b9b2a679986c7d5
parent22d2441089751ab75a5d01ceb99f5fa3f21b1356 (diff)
parent96f8fc81311574307013ca7a6f4abc589600d848 (diff)
downloadtcl-42a533ea114536fc5140078428fa7714bbe3c504.zip
tcl-42a533ea114536fc5140078428fa7714bbe3c504.tar.gz
tcl-42a533ea114536fc5140078428fa7714bbe3c504.tar.bz2
merge trunk
-rw-r--r--generic/tclEnv.c6
-rw-r--r--tests/env.test36
2 files changed, 26 insertions, 16 deletions
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 2cb240d..66ddb57 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -551,7 +551,8 @@ TclGetEnv(
* array.
*
* Results:
- * Always returns NULL to indicate success.
+ * Returns NULL to indicate success, or an error-message if the array
+ * element being handled doesn't exist.
*
* Side effects:
* Environment variable changes get propagated. If the whole "env" array
@@ -609,8 +610,7 @@ EnvTraceProc(
const char *value = TclGetEnv(name2, &valueString);
if (value == NULL) {
- Tcl_UnsetVar2(interp, name1, name2, 0);
- return NULL;
+ return (char *) "no such variable";
}
Tcl_SetVar2(interp, name1, name2, value, 0);
Tcl_DStringFree(&valueString);
diff --git a/tests/env.test b/tests/env.test
index 83d99e0..9f59fbc 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -278,20 +278,20 @@ test env-5.4 {corner cases - unset the env array} -setup {
} -cleanup {
interp delete i
} -result {1 a 1}
-test env-5.5 {corner cases - cannot have null entries on Windows} {win} {
+test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body {
set env() a
catch {set env()}
-} {1}
+} -result 1
-test env-6.1 {corner cases - add lots of env variables} {} {
+test env-6.1 {corner cases - add lots of env variables} -body {
set size [array size env]
for {set i 0} {$i < 100} {incr i} {
set env(BOGUS$i) $i
}
expr {[array size env] - $size}
-} 100
+} -result 100
-test env-7.1 {[219226]: whole env array should not be unset by read} {
+test env-7.1 {[219226]: whole env array should not be unset by read} -body {
set n [array size env]
set s [array startsearch env]
while {[array anymore env $s]} {
@@ -300,19 +300,29 @@ test env-7.1 {[219226]: whole env array should not be unset by read} {
}
array donesearch env $s
return $n
-} 0
-test env-7.2 {[219226]: links to env elements should not be removed by read} {
+} -result 0
+
+test env-7.2 {[219226]: links to env elements should not be removed by read} -body {
apply {{} {
set ::env(test7_2) ok
upvar env(test7_2) elem
set ::env(PATH)
- try {
- return $elem
- } finally {
- unset ::env(test7_2)
- }
+ return $elem
+ }}
+} -result ok
+
+test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body {
+ apply {{} {
+ catch {unset ::env(test7_3)}
+ proc foo args {
+ set ::env(test7_3) ok
+ }
+ trace add variable ::env(not_yet_existent) write foo
+ info exists ::env(not_yet_existent)
+ set ::env(not_yet_existent) "Now I'm here";
+ return [info exists ::env(test7_3)]
}}
-} ok
+} -result 1
# Restore the environment variables at the end of the test.