summaryrefslogtreecommitdiffstats
path: root/tests/env.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/env.test')
-rw-r--r--tests/env.test147
1 files changed, 106 insertions, 41 deletions
diff --git a/tests/env.test b/tests/env.test
index 043748a..83d99e0 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -10,8 +10,6 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: env.test,v 1.30 2008/07/19 21:47:55 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -61,6 +59,7 @@ test env-1.3 {reflection of env by "array names"} -setup {
} -result {1}
set printenvScript [makeFile {
+ encoding system iso8859-1
proc lrem {listname name} {
upvar $listname list
set i [lsearch -nocase $list $name]
@@ -71,25 +70,26 @@ set printenvScript [makeFile {
}
proc mangle s {
regsub -all {\[|\\|\]} $s {\\&} s
- regsub -all {[\u007f-\uffff]} $s {[manglechar &]} s
+ regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
return [subst -novariables $s]
}
proc manglechar c {
return [format {\u%04x} [scan $c %c]]
}
-
+
set names [lsort [array names env]]
if {$tcl_platform(platform) eq "windows"} {
lrem names HOME
lrem names COMSPEC
lrem names ComSpec
lrem names ""
- }
+ }
foreach name {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
- __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG
+ __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
+ CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
} {
lrem names $name
}
@@ -98,6 +98,7 @@ set printenvScript [makeFile {
}
exit
} printenv]
+
# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
@@ -119,66 +120,107 @@ foreach name [array names env] {
TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
- SECURITYSESSIONID LANG
+ SECURITYSESSIONID LANG WINDIR TERM
+ CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
}} {
unset env($name)
}
}
-test env-2.1 {adding environment variables} {exec} {
+# Need to run 'getenv' in known encoding, so save the current one here...
+set sysenc [encoding system]
+
+test env-2.1 {adding environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
getenv
-} {}
-set env(NAME1) "test string"
-test env-2.2 {adding environment variables} {exec} {
+} -cleanup {
+ encoding system $sysenc
+} -result {}
+test env-2.2 {adding environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ set env(NAME1) "test string"
getenv
-} {NAME1=test string}
-set env(NAME2) "more"
-test env-2.3 {adding environment variables} {exec} {
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string}
+test env-2.3 {adding environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ set env(NAME2) "more"
getenv
-} {NAME1=test string
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string
NAME2=more}
-set env(XYZZY) "garbage"
-test env-2.4 {adding environment variables} {exec} {
+test env-2.4 {adding environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ set env(XYZZY) "garbage"
getenv
-} {NAME1=test string
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string
NAME2=more
XYZZY=garbage}
set env(NAME2) "new value"
-test env-3.1 {changing environment variables} {exec} {
+test env-3.1 {changing environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
set result [getenv]
unset env(NAME2)
set result
-} {NAME1=test string
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string
NAME2=new value
XYZZY=garbage}
-test env-4.1 {unsetting environment variables} {exec} {
- set result [getenv]
- unset env(NAME1)
- set result
-} {NAME1=test string
+test env-4.1 {unsetting environment variables: default} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ getenv
+} -cleanup {
+ encoding system $sysenc
+} -result {NAME1=test string
XYZZY=garbage}
-test env-4.2 {unsetting environment variables} {exec} {
- set result [getenv]
+test env-4.2 {unsetting environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
+ unset env(NAME1)
+ getenv
+} -cleanup {
unset env(XYZZY)
- set result
-} {XYZZY=garbage}
-test env-4.3 {setting international environment variables} {exec} {
+ encoding system $sysenc
+} -result {XYZZY=garbage}
+test env-4.3 {setting international environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
set env(\ua7) \ub6
getenv
-} {\u00a7=\u00b6}
-test env-4.4 {changing international environment variables} {exec} {
+} -cleanup {
+ encoding system $sysenc
+} -result {\u00a7=\u00b6}
+test env-4.4 {changing international environment variables} -setup {
+ encoding system iso8859-1
+} -constraints {exec} -body {
set env(\ua7) \ua7
getenv
-} {\u00a7=\u00a7}
-test env-4.5 {unsetting international environment variables} {exec} {
+} -cleanup {
+ encoding system $sysenc
+} -result {\u00a7=\u00a7}
+test env-4.5 {unsetting international environment variables} -setup {
+ encoding system iso8859-1
+} -body {
set env(\ub6) \ua7
unset env(\ua7)
- set result [getenv]
+ getenv
+} -constraints {exec} -cleanup {
unset env(\ub6)
- set result
-} {\u00b6=\u00a7}
+ encoding system $sysenc
+} -result {\u00b6=\u00a7}
test env-5.0 {corner cases - set a value, it should exist} -body {
set env(temp) a
@@ -200,7 +242,7 @@ test env-5.1 {corner cases - remove one elem at a time} -setup {
array set env $x
} -result {0}
test env-5.2 {corner cases - unset the env array} -setup {
- interp create i
+ interp create i
} -body {
# Unsetting a variable in an interp detaches the C-level traces from the
# Tcl "env" variable.
@@ -212,8 +254,8 @@ test env-5.2 {corner cases - unset the env array} -setup {
} -cleanup {
interp delete i
} -result {0}
-test env-5.3 {corner cases - unset the env in master should unset child} -setup {
- interp create i
+test env-5.3 {corner cases: unset the env in master should unset child} -setup {
+ interp create i
} -body {
# Variables deleted in a master interp should be deleted in child interp
# too.
@@ -225,7 +267,7 @@ test env-5.3 {corner cases - unset the env in master should unset child} -setup
interp delete i
} -result {a 1}
test env-5.4 {corner cases - unset the env array} -setup {
- interp create i
+ interp create i
} -body {
# The info exists command should be in synch with the env array.
# Know Bug: 1737
@@ -249,6 +291,29 @@ test env-6.1 {corner cases - add lots of env variables} {} {
expr {[array size env] - $size}
} 100
+test env-7.1 {[219226]: whole env array should not be unset by read} {
+ set n [array size env]
+ set s [array startsearch env]
+ while {[array anymore env $s]} {
+ array nextelement env $s
+ incr n -1
+ }
+ array donesearch env $s
+ return $n
+} 0
+test env-7.2 {[219226]: links to env elements should not be removed by read} {
+ apply {{} {
+ set ::env(test7_2) ok
+ upvar env(test7_2) elem
+ set ::env(PATH)
+ try {
+ return $elem
+ } finally {
+ unset ::env(test7_2)
+ }
+ }}
+} ok
+
# Restore the environment variables at the end of the test.
foreach name [array names env] {
generated by cgit v0.12 at 2025-11-15 23:31:55 (GMT)