diff options
Diffstat (limited to 'tests/env.test')
| -rw-r--r-- | tests/env.test | 46 |
1 files changed, 35 insertions, 11 deletions
diff --git a/tests/env.test b/tests/env.test index 7d7e5fa..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.31 2009/05/07 10:34:42 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -72,25 +70,26 @@ set printenvScript [makeFile { } proc mangle s { regsub -all {\[|\\|\]} $s {\\&} s - regsub -all {[\u0000-\u001f\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 } @@ -99,6 +98,7 @@ set printenvScript [makeFile { } exit } printenv] + # [exec] is required here to see the actual environment received by child # processes. proc getenv {} { @@ -120,7 +120,8 @@ 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) } @@ -217,8 +218,8 @@ test env-4.5 {unsetting international environment variables} -setup { unset env(\ua7) getenv } -constraints {exec} -cleanup { - encoding system $sysenc unset env(\ub6) + encoding system $sysenc } -result {\u00b6=\u00a7} test env-5.0 {corner cases - set a value, it should exist} -body { @@ -241,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. @@ -254,7 +255,7 @@ test env-5.2 {corner cases - unset the env array} -setup { interp delete i } -result {0} test env-5.3 {corner cases: unset the env in master should unset child} -setup { - interp create i + interp create i } -body { # Variables deleted in a master interp should be deleted in child interp # too. @@ -266,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 @@ -290,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] { |