diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/env.test | 66 |
1 files changed, 38 insertions, 28 deletions
diff --git a/tests/env.test b/tests/env.test index 47ada47..c42e49d 100644 --- a/tests/env.test +++ b/tests/env.test @@ -1,15 +1,15 @@ # Commands covered: none (tests environment variable implementation) # -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -21,9 +21,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint exec [llength [info commands exec]] # -# These tests will run on any platform (and indeed crashed -# on the Mac). So put them before you test for the existance -# of exec. +# These tests will run on any platform (and indeed crashed on the Mac). So put +# them before you test for the existance of exec. # test env-1.1 {propagation of env values to child interpreters} { catch {interp delete child} @@ -36,8 +35,8 @@ test env-1.1 {propagation of env values to child interpreters} { set return } {garbage} # -# This one crashed on Solaris under Tcl8.0, so we only -# want to make sure it runs. +# This one crashed on Solaris under Tcl8.0, so we only want to make sure it +# runs. # test env-1.2 {lappend to env value} { catch {unset env(test)} @@ -66,28 +65,37 @@ set printenvScript [makeFile { } return $list } - + proc mangle s { + regsub -all {\[|\\|\]} $s {\\&} 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) == "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 WINDIR TERM + CommonProgramFiles ProgramFiles } { lrem names $name } foreach p $names { - puts "$p=$env($p)" + puts "[mangle $p]=[mangle $env($p)]" } exit } printenv] - + # [exec] is required here to see the actual environment received # by child processes. proc getenv {} { @@ -101,16 +109,16 @@ proc getenv {} { # Save the current environment variables at the start of the test. +set env2 [array get env] foreach name [array names env] { - set env2($name) $env($name) - - # Keep some environment variables that support operation of the - # tcltest package. + # Keep some environment variables that support operation of the tcltest + # package. if {[string toupper $name] ni { - 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 WINDIR TERM + 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 WINDIR TERM + CommonProgramFiles ProgramFiles }} { unset env($name) } @@ -163,18 +171,18 @@ test env-4.2 {unsetting environment variables} {exec} { test env-4.3 {setting international environment variables} {exec} { set env(\ua7) \ub6 getenv -} "\ua7=\ub6" +} {\u00a7=\u00b6} test env-4.4 {changing international environment variables} {exec} { set env(\ua7) \ua7 getenv -} "\ua7=\ua7" +} {\u00a7=\u00a7} test env-4.5 {unsetting international environment variables} {exec} { set env(\ub6) \ua7 unset env(\ua7) set result [getenv] unset env(\ub6) set result -} "\ub6=\ua7" +} {\u00b6=\u00a7} test env-5.0 {corner cases - set a value, it should exist} {} { set env(temp) a @@ -249,11 +257,13 @@ test env-6.1 {corner cases - add lots of env variables} {} { foreach name [array names env] { unset env($name) } -foreach name [array names env2] { - set env($name) $env2($name) -} +array set env $env2 # cleanup removeFile $printenvScript ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End: |